message.pl: Implement.

Lookup by message, message-id header, supports HTML formatted or raw output as
well as retrieving specific MIME parts.

diff --git a/CGI/bug.pl b/CGI/bug.pl
index 4ebced82b8bc64ff4b24607f7dc5955f563a7086..fb871ab9e1ff915518e5d18c91022c4f17c0562e 100755 (executable)
--- a/CGI/bug.pl
+++ b/CGI/bug.pl
@@ -56,22 +56,7 @@ my %handlers = (
             print header( -type => 'application/mbox', -charset => 'utf-8', );
         },
         Message => sub ($) {
-            my $m = shift;
-            eval {
-                my $fh;
-
-             # Could forge a placeholder for messages which aren't present here.
-
-                $fh = $m->headers;
-                print for (<$fh>);
-
-                print "\n";
-
-                $fh = $m->body;
-                print for (<$fh>);
-            };
-
-            # Ignore errors...
+            eval { format_raw(shift) };    # Ignore errors...
         },
         Footer => sub () { }
     },

diff --git a/CGI/message.pl b/CGI/message.pl
index c8072ea55d88f7e9dcc7a824c94755b717461786..b9abfa9eb28ad842af93300e0b89ffe9d3203655 100755 (executable)
--- a/CGI/message.pl
+++ b/CGI/message.pl
@@ -12,6 +12,9 @@ use Emesinae::Bug;
 use Emesinae::Common;
 
 use Emesinae::CGI;
+use Emesinae::CGI::Message;
+
+use URI::Escape;
 
 readconfig;
 my $dbh = opendb;
@@ -36,5 +39,71 @@ sub fourohfour() {
     exit(0);
 }
 
-# Not implemented yet.
-fourohfour();
+# Parse path to determine message number (or ID) and (optional) mode (raw, part
+# etc):
+
+my $path = url( -absolute => 1 );
+
+$path =~ s,^$c{CGIPath},,   or fourohfour();
+$path =~ m,^(mid|message)/, or fourohfoud();
+my $lookup_key = $1;
+$path =~ s,^$lookup_key,,;
+
+my $idre;
+if    ( $lookup_key eq "message" ) { $idre = "[0-9]+"; }
+elsif ( $lookup_key eq "mid" )     { $idre = ".+?"; }      # Not greedy.
+die "unknown key" unless $idre;
+
+$path =~ m,^/($idre)(?:/(raw|part/[0-9]+))?/?$, or fourohfour();
+
+my $lookup_value = $1;
+
+my $mode = $2 || "normal";
+
+my ( $msg, $partid );
+
+if ( $mode =~ m,^part/([0-9]+)/?$, ) {
+    $mode   = "part";
+    $partid = $1;
+}
+
+eval {
+    if ( $lookup_key eq "message" )
+    {
+        $msg = Emesinae::Message->lookup_id( $dbh, $lookup_value );
+    }
+    elsif ( $lookup_key eq "mid" ) {
+        $lookup_value = uri_unescape($lookup_value);
+        $msg = Emesinae::Message->lookup_msgid( $dbh, $lookup_value );
+    }
+};
+fourohfour() if $@;
+fourohfour() unless $msg;
+
+if ( $mode eq "raw" ) {
+    print header( -type => 'text/plain', -charset => 'utf-8' );
+    format_raw($msg) or print "Message not present in archive\n";
+}
+elsif ( $mode eq "normal" ) {
+    print header( -charset => 'utf-8', );
+
+    my $title;
+    if ( $msg->{present} ) {
+        $title =
+          "message " . $msg->{id} . " - " . htmlsanit( $msg->{subject}->text );
+    }
+    else {
+        $title = "message " . $msg->{id} . " - (Not Present)";
+    }
+    print start_html(
+        -title => $c{TrackerName} . ": " . $title,
+        -style => { 'src' => $c{StyleSheet} }
+    );
+    format_html( $msg, undef );
+    print end_html;
+}
+elsif ( $mode eq "part" ) {
+    fourohfour unless $msg->{present};
+    format_part( $msg, $partid );
+
+}

diff --git a/Emesinae/CGI/Message.pm b/Emesinae/CGI/Message.pm
index 9e40c3cd9920d63fab5900df69daa9e52595b8fb..3e1e30f59b0eee1da5a3127e0c1ccd888c71c435 100644 (file)
--- a/Emesinae/CGI/Message.pm
+++ b/Emesinae/CGI/Message.pm
@@ -17,13 +17,17 @@ use Emesinae::Message;
 use Emesinae::Common;
 use Emesinae::CGI;
 
+use IO::Scalar;
+
 BEGIN {
     use Exporter ();
     our ( $VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
     $VERSION = 1.00;
     @ISA     = qw(Exporter);
     @EXPORT  = qw(
-        format_html
+      format_html
+      format_raw
+      format_part
     );
     %EXPORT_TAGS = ();
 
@@ -55,11 +59,13 @@ sub resubject ($) {
 }
 
 sub reply_link ($$) {
-    my $m = shift;
+    my $m   = shift;
     my $bug = shift;
 
     my $p = $m->{present};
 
+    return "" unless $p and defined $bug;
+
     my %hdrs = ( "In-Reply-To" => $m->{msgid}, );
 
     my $to = join( ",", $m->{from}->addresses );
@@ -148,8 +154,8 @@ sub parthdr {
       . " ($type, $disposition)" . "]";
 }
 
-sub format_html ($$) {
-    my $m = shift;
+sub format_html ($;$) {
+    my $m   = shift;
     my $bug = shift;
 
     print comment( "Message "
@@ -187,10 +193,12 @@ sub format_html ($$) {
             )
         )
     ) . "\n";
+    my $reply = reply_link( $m, $bug );
+    $reply .= "; " if $reply;
     print p(
         { -class => "msgcontrol" },
-        "[ "
-          . reply_link($m, $bug) . "; "
+        "[ " 
+          . $reply
           . raw_link($m) . "; "
           . "Archives: "
           . join( ", ", @archives ) . " ]"
@@ -226,4 +234,48 @@ sub format_html ($$) {
     }
 }
 
+sub format_raw($) {
+    my $m = shift;
+    my $fh;
+
+    # Could forge a placeholder for messages which aren't present here.
+    return 0 unless $m->{present};
+
+    $fh = $m->headers;
+    print for (<$fh>);
+
+    print "\n";
+
+    $fh = $m->body;
+    print for (<$fh>);
+
+    return 1;
+}
+
+sub format_part($$) {
+    my $m    = shift;
+    my $part = shift;
+
+    my $tempdir = File::Temp::tempdir();
+    my $e       = $m->get_mime($tempdir);
+
+    my @parts  = getmailparts($e);
+    my $entity = $parts[ $part - 1 ];
+    my $head   = $entity->head;
+
+    my $filename = $head->recommended_filename;
+    $filename = '' unless defined $filename;
+
+    my $body = $entity->stringify_body;
+
+    chomp( my $type = $entity->effective_type );
+    print "Content-Type: $type";
+    print "; name=\"$filename\"" if $filename ne '';
+    print "\n\n";
+    my $decoder = new MIME::Decoder( $head->mime_encoding );
+    $decoder->decode( new IO::Scalar( \$body ), \*STDOUT );
+
+    rmtree $tempdir, 0, 1;
+}
+
 1;

diff --git a/README b/README
index 67a464082bd19cf0d5151bd57c9ccb730cabd629..fa6a9bb2a9ea254fe10c1e2100951b098c51a9c6 100644 (file)
--- a/README
+++ b/README
@@ -4,6 +4,7 @@ Dependencies:
   libmime-tools-perl
   libdbd-sqlite3-perl
   liburi-perl
+  libio-stringy-perl
 
   libjs-jquery
 

diff --git a/TODO b/TODO
index f9c4b548f275fa5abbf643fd6b80c78783b95b32..503f182accde174d7a0ad6bea38849e14180db6c 100644 (file)
--- a/TODO
+++ b/TODO
@@ -31,11 +31,6 @@ bugs.pl:
  - SEO
     - make sure there is an index page of all bugs for them to start from
 
-message.pl:
- - Write it
-   - return entire raw message
-   - return individual parts
-
 database:
  - Add "created-by" and "reported-by" fields to bug, allow owner to be NULL by
    default.

diff --git a/config/examples/test/apache.conf b/config/examples/test/apache.conf
index b6469f811f96017fa059721dbfa9295f3d230eb3..064b56f755de31218fe583ae16d8b01e57809fa5 100644 (file)
--- a/config/examples/test/apache.conf
+++ b/config/examples/test/apache.conf
@@ -18,6 +18,7 @@
        Alias /test/static/ /srv/test/var/www/
        ScriptAliasMatch /test/bug/.* /srv/test/lib/emesinae/cgi-bin/bug.cgi
        ScriptAliasMatch /test/message/.* /srv/test/lib/emesinae/cgi-bin/message.cgi
+       ScriptAliasMatch /test/mid/.* /srv/test/lib/emesinae/cgi-bin/message.cgi
        ScriptAlias /test/ /srv/test/lib/emesinae/cgi-bin/bugs.cgi
        <Directory "/srv/test/lib/emesinae/cgi-bin">
                AllowOverride None

diff --git a/config/examples/xen-bugs.xenproject.org/apache.conf b/config/examples/xen-bugs.xenproject.org/apache.conf
index 5ee3ee35c2f6f4dca2e7791c8a03d2bae55727cf..99dab546acf2ee1f2ff787296e9c3d4fcb4739b4 100644 (file)
--- a/config/examples/xen-bugs.xenproject.org/apache.conf
+++ b/config/examples/xen-bugs.xenproject.org/apache.conf
@@ -15,6 +15,7 @@
        Alias /xen/static/ /srv/xen-devel-bugs/var/www/
        ScriptAliasMatch /xen/bug/.* /srv/xen-devel-bugs/lib/emesinae/cgi-bin/bug.cgi
        ScriptAliasMatch /xen/message/.* /srv/xen-devel-bugs/lib/emesinae/cgi-bin/message.cgi
+       ScriptAliasMatch /xen/mid/.* /srv/test/lib/emesinae/cgi-bin/message.cgi
        ScriptAlias /xen/ /srv/xen-devel-bugs/lib/emesinae/cgi-bin/bugs.cgi
        <Directory "/srv/xen-devel-bugs/lib/emesinae/cgi-bin">
                AllowOverride None