--- toast	2010/01/10 02:43:08	1.473
+++ toast	2010/01/10 22:05:51	1.474
@@ -44,6 +44,7 @@
 my($myname, $myversion, $mytimestamp, $myauthor) = ($1, $2, $3, $4);
 $myversion .= "+" if $5; # if this version may contain changes not in RCS
 my($myurl) = "http://www.toastball.net/toast/";
+my($bugurl) = $myurl . "sendbug";
 my($mycopyright) = "Copyright (C) 2003-2010 Jacques Frechet";
 my($genby) = "generated by $myname version $myversion [$myurl]";
 $myname eq "toast" && $myauthor eq "zaphod" || die; # avoid accidents w/ CVS
@@ -677,6 +678,7 @@
 }
 
 sub getmode($) { (safestat($_[0]))[2] & 07777 }
+sub getmtime($) { (safestat($_[0]))[9] }
 
 sub chmodimpl($$@)
 {
@@ -950,13 +952,13 @@
   return $ip;
 }
 
-sub openhttp(*$;$;$)
+sub openhttp(*$;$;$;$;$)
 {
   local(*HANDLE) = shift;
-  my($url, $method, $proxy) = @_;
+  my($url, $method, $proxy, $body) = @_;
   $method ||= "GET";
   $proxy = httpproxy unless defined($proxy);
-  explain("fetching $url");
+  explain("$method $url" . ($proxy ? " via $proxy" : ""));
   $url =~ m!^(\w+)://([-\w\.]+)(:(\d+))?(/[\!-\~]*)?$! ||
       error("bad url: $url");
   my($proto, $host, $port, $path) = ($1, $2, $4 || 80, $5 || '/');
@@ -969,10 +971,13 @@
     ($host, $port) = ($2, $4 || 8080);
   }
   my($uagent) = "$myname/$myversion ($^O; $myurl)";
+  my($clen) = defined($body) ? "Content-Length: ".length($body)."\r\n" : "";
+  $body = "" unless defined($body);
   my($request) = "$method $path HTTP/1.0\r\nHost: $hdrhost\r\n".
-      "User-Agent: $uagent\r\nAccept: */*\r\n\r\n";
+      "User-Agent: $uagent\r\nAccept: */*\r\n$clen\r\n$body";
   tcpconnect(*HANDLE, $host, $port);
   print HANDLE $request || error("write to $host:$port: $!");
+  shutdown(HANDLE, 1) || error("shutdown write $host:$port: $!");
 }
 
 sub httphead($)
@@ -985,6 +990,19 @@
   return $result;
 }
 
+sub httppost($$)
+{
+  my($url, $post) = @_;
+  local(*HANDLE);
+  openhttp(*HANDLE, $url, "POST", undef, $post);
+  my($result) = join('', <HANDLE>);
+  close(HANDLE) || error;
+  $result =~ s|^HTTP/[\w\.]+ (\d+) .*?\r?\n\r?\n||s
+      || error("bad POST response from $url: $result");
+  $1 eq "200" || error("POST to $url returned HTTP response code $1");
+  return $result;
+}
+
 sub openhttpurl(*$;$)
 {
   local(*HANDLE) = shift;
@@ -2207,7 +2225,8 @@
 sub isbroken($$$)
 {
   my($name, $version, $build) = @_;
-  return -f(path(pkgpath($name, $version, $build), brokenlog));
+  my($log) = path(pkgpath($name, $version, $build), brokenlog);
+  return -f($log) ? $log : false;
 }
 
 sub isclean($$$)
@@ -4322,6 +4341,7 @@
 
   my($logname) = path($builddir, $success ? buildlog : brokenlog);
   mv($tmplogname, $logname);
+  explain('build failed; use "toast bug" to send a bug report') if !$success;
   $success || error($msg);
 
   clean($name, $version, $build) if autoclean;
@@ -5154,6 +5174,36 @@
 
 ##############################################################################
 
+sub bug(@)
+{
+  my($name, $version, $build, @urls) = @_;
+
+  my(%logs);
+  for $name (allnames($name))
+  {
+    for $version (allversions($name, $version))
+    {
+      for $build (allbuilds($name, $version, $build))
+      {
+        my($log) = isbroken($name, $version, $build);
+        $logs{$log} = getmtime($log) if $log;
+      }
+    }
+  }
+
+  return true unless %logs;
+  my(@logs) = sort { $logs{$b} <=> $logs{$a} } keys(%logs);
+  my($path) = $logs[0];
+
+  explain("sending $path");
+  my($result) = httppost($bugurl, join('', readfile($path)));
+  $result =~ s/\s*$//;
+  error("server error: $result") unless $result eq "ok";
+  return true;
+}
+
+##############################################################################
+
 BEGIN
 {
   my($checkresult);
@@ -5766,6 +5816,7 @@
 sub parse_rename(@);
 sub parse_change(@) { requireurls(rejectempty(rejectmissing(uselatestversion(rejectbuilds(parse(@_)))))); }
 sub parse_status(@) { allowempty(rejectmissing(parse(@_))); }
+sub parse_bug(@) { allowempty(rejectmissing(parse(@_))); }
 sub parse_check(@) { rejectall(@_); }
 sub parse_env(@) { rejectall(@_); }
 sub parse_help(@) { allowall(@_); }
@@ -7145,6 +7196,20 @@
 the build will be marked C<(not clean)> if intermediate files created
 by B<toast build> have not yet been removed by C<toast clean>.
 
+=item S<B<toast bug> [ I<BUILD> | I<PACKAGE> ] ...>
+
+Sends a bug report about a broken build.  Use this command to let
+me know when you think B<toast> ought to be able to build a package,
+but it isn't working.  If you would like to hear back from me about
+your bug report, or if there's anything else you think I should know,
+email me at C<toast-bugs@toastball.net>.  If invoked without arguments,
+sends build output from the most recent broken build; otherwise, sends
+build output from the most recent broken build for each argument.  Build
+output for each broken build is stored in a file called B<broken.log>
+somewhere under I<STOREDIR>; each file contains full output from the
+build subprocess (the indented lines printed by B<toast build> unless
+the B<quiet> option is in force).
+
 =item S<B<toast env>>
 
 Prints shell commands to make armed packages usable.  This command is
@@ -7432,14 +7497,14 @@
 
 Specifies additional arguments for B<toast build> to pass to a package's
 C<configure> script or equivalent, if any.  This should never be necessary
-in order to build a package correctly (if it is, send me a bug report!),
-but it can be awfully handy at times.  The I<ARGS> string is treated
-as a list of space-separated words, each of which may be optionally
-quoted with single or double quotes with backslash acting as an escape
-character; the resulting words are added to the end of the command line.
-Note that by default, this option's value may be saved with the package
-and reused by future invocations of B<toast>; see the B<stickyopts>
-option for details.  Default: empty string.
+in order to build a package correctly (if it is, use B<toast bug> to send
+me a bug report!), but it can be awfully handy at times.  The I<ARGS>
+string is treated as a list of space-separated words, each of which may
+be optionally quoted with single or double quotes with backslash acting
+as an escape character; the resulting words are added to the end of the
+command line.  Note that by default, this option's value may be saved
+with the package and reused by future invocations of B<toast>; see the
+B<stickyopts> option for details.  Default: empty string.
 
 =item B<--makeappend=>I<ARGS>
 
@@ -7923,9 +7988,10 @@
 
 =head1 BUGS
 
-Please report any bugs, unexpected behavior, unsurprising but inconvenient
-failures, feature requests, comments, and so on to C<toast-bugs> at the
-hostname of the B<toast> distribution site, C<toastball.net>.
+Please report any bugs, unexpected behavior, unsurprising but
+inconvenient failures, feature requests, comments, and so on to
+C<toast-bugs@toastball.net>.  You can also use B<toast bug> to report
+problems with specific packages that refuse to build.
 
 Known bugs: