/[mws]/trunk/httpd.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/httpd.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 28 by dpavlin, Sat May 8 22:18:38 2004 UTC revision 47 by dpavlin, Tue May 11 22:59:27 2004 UTC
# Line 3  Line 3 
3  # based on post  # based on post
4  # http://www.mail-archive.com/libwww@perl.org/msg04750.html  # http://www.mail-archive.com/libwww@perl.org/msg04750.html
5    
6    BEGIN {
7            my $basedir = readlink($0) || $0; $basedir =~ s#/[^/]+$##;
8            unshift(@INC, $basedir);
9    }
10    
11    =head1 NAME
12    
13    httpd.pl - http server for Mail::Box Web Search
14    
15    =head1 SYNOPSYS
16    
17     httpd.pl [local.conf]
18    
19    =head1 DESCRIPTION
20    
21    This is small http server, based on C<HTTP::Daemon> which is designed
22    for single-user use (on laptop for example) via loopback.
23    
24    It doesn't provide any authentification or authorisation, and it can handle
25    just one request at the time, so it's not suted for public-facing sites,
26    even if you don't care about security of your mailboxes.
27    
28    =head1 SEE ALSO
29    
30    C<MWS> perl modules which are part of this package
31    
32    =cut
33    
34  use strict;  use strict;
35  use warnings;  use warnings;
36    use MWS::SWISH;
37    #use MWS::Plucene;
38  use HTTP::Daemon;  use HTTP::Daemon;
39  use HTTP::Status;  use HTTP::Status;
40  use IO::String;  use IO::String;
41  use CGI::Lite;  use CGI::Lite;
42  use Template;  use Template;
 use MWS;  
43  use URI::Escape;  use URI::Escape;
44    
45  use Data::Dumper;  use Data::Dumper;
# Line 28  be used. Line 57  be used.
57          exit 1;          exit 1;
58  }  }
59    
60  my $d = HTTP::Daemon->new( Reuse => 1, LocalPort => 6969 ) || die;  my $mws = MWS::SWISH->new(config_file => $config_file);
61    #my $mws = MWS::Plucene->new(config_file => $config_file, debug => $debug);
62    
63    my ($local_addr,$local_port) = ('127.0.0.1',6969);
64    
65    my $listen = $mws->{config}->val('global', 'listen');
66    
67    print STDERR "using listen $listen\n" if ($listen);
68    
69    if ($listen && $listen =~ m/:/) {
70            ($local_addr,$local_port) = split(/:/,$listen,2);
71    } elsif ($listen) {
72            $local_addr = $listen;
73    }
74    
75    my $d = HTTP::Daemon->new(
76            Reuse => 1,
77            LocalAddr => $local_addr,
78            LocalPort => $local_port,
79    ) || die "can't create HTTP::Daemon on $local_addr:$local_port: $!";
80    
81  my $cgi = new CGI::Lite;  my $cgi = new CGI::Lite;
 my $mws = MWS->new($config_file);  
82  my $tt = Template->new({  my $tt = Template->new({
83          INCLUDE_PATH => $mws->{config}->val('global', 'templates'),          INCLUDE_PATH => $mws->{config}->val('global', 'templates'),
84          FILTERS => {          FILTERS => {
# Line 85  while ( my $c = $d->accept ) { Line 133  while ( my $c = $d->accept ) {
133                  my $url = $r->url->path;                  my $url = $r->url->path;
134    
135                  # XXX LOG                  # XXX LOG
136                  print $r->method," ",$url,"\n",Dumper($param),"\n" if ($debug);                  print $r->method," ",$url,"\n";
137                    print Dumper($param,$mws->{counter}),"\n" if ($debug);
138    
139                  # is this static page?                  # is this static page?
140                  if ($static_html && -f "$static_html/$url") {                  if ($static_html && -f "$static_html/$url") {
# Line 173  while ( my $c = $d->accept ) { Line 222  while ( my $c = $d->accept ) {
222                          $tpl_var->{results} = \@res if (@res);                          $tpl_var->{results} = \@res if (@res);
223                          $tpl_var->{total_hits} = $mws->{total_hits} || 0;                          $tpl_var->{total_hits} = $mws->{total_hits} || 0;
224    
225                            # no hits, offer suggestions
226                            if (! $tpl_var->{results}) {
227                                    @{$tpl_var->{apropos}} = $mws->apropos_index($param->{'search_fld'}, $param->{'search_val'});
228                            }
229    
230                  }                  }
231    
232    
233                  # push counters to template                  # push counters to template
234                  foreach my $f (qw(from to cc bcc)) {                  foreach my $f (qw(from to cc bcc folder)) {
235                          my $h = $mws->counter($f) || next;                          my $h = $mws->counter($f) || next;
236                          my @a;                          my @a;
237                          foreach my $k (sort { $h->{$b}->{usage} <=> $h->{$a}->{usage} } keys %$h) {                          foreach my $k (sort { $h->{$b}->{usage} <=> $h->{$a}->{usage} } keys %$h) {
# Line 208  while ( my $c = $d->accept ) { Line 262  while ( my $c = $d->accept ) {
262  # template toolkit filter  # template toolkit filter
263    
264  sub html_escape($) {  sub html_escape($) {
265          my $text = shift;          my $text = shift || return;
266    
267            # don't re-escape html
268            #return $text if ($text =~ /&(?:lt|gt|amp|quot);/);
269    
270          # Escape <, >, & and ", and to produce valid XML          # Escape <, >, & and ", and to produce valid XML
271          my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');          my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');
272          my $escape_re  = join '|' => keys %escape;          my $escape_re  = join '|' => keys %escape;
273    
274          $text =~ s/($escape_re)/$escape{$1}/gs;          $text =~ s/($escape_re)/$escape{$1}/gs;
275    
276            while ($text =~ s/#-#(quote|signature)(\d*)##(.+?)##\1\2#-#/<span class="$1">$3<\/span>/gs) { } ;
277    
278          return $text;          return $text;
279  }  }
280    
# Line 224  sub body5_filter { Line 284  sub body5_filter {
284          my $text = shift;          my $text = shift;
285    
286          # remove quote          # remove quote
287          $text =~ s/^[\>:\|=]+\s*.*?$/#-q-#/msg;          $text =~ s/^[\>:\|=]+[^\n\r]*[\n\r]*$/#-q-#/msg;
288          # remove quote author          # remove quote author
289          $text =~ s/[\n\r]+[^\n\r]+:\s*(:?#-q-#[\n\r*])+//gs;          $text =~ s/[\n\r]+[^\n\r]+:\s*(?:#-q-#[\n\r*])+//gs;
290          $text =~ s/^[^\n\r]+:\s*(:?#-q-#[\n\r]*)+//gs;          $text =~ s/^[^\n\r]+:\s*(?:#-q-#[\n\r]*)+//gs;
291            $text =~ s/#-q-#[\n\r]*//gs;
292          # outlook quoting          # outlook quoting
293          $text =~ s/(\s*--+\s*Original\s+Message\s*--+.*)$//si;          $text =~ s/(\s*--+\s*Original\s+Message\s*--+.*)$//si;
294          $text =~ s/(\s*--+\s*Forwarded\s+message\s*from\s+.+\s*--+.*)$//si;          $text =~ s/(\s*--+\s*Forwarded\s+message.+\s*--+.*)$//si;
295    
296          # remove signature          # remove signature
297          $text =~ s/[\n\r]+--\s*[\n\r]+.*$//s;          $text =~ s/(?:^|[\n\r]+)*--\s*[\n\r]+.*$//s;
298            $text =~ s/(?:^|[\n\r]+)*_____+[\n\r]+.*$//s;
299    
300          # compress cr/lf          # compress cr/lf
301          $text =~ s/[\n\r]+/\n/gs;          $text =~ s/[\n\r]+/\n/gs;
# Line 242  sub body5_filter { Line 304  sub body5_filter {
304          $text =~ s/^\n+//gs;          $text =~ s/^\n+//gs;
305          $text =~ s/[\s\n]+$//gs;          $text =~ s/[\s\n]+$//gs;
306    
307            if ($text eq "") {
308                    $text="#-#quote##forwarded message##quote#-#";
309            }
310    
311          # cut to 5 lines;          # cut to 5 lines;
312          if ($text =~ s,^((?:.*?[\n\r]){5}).*$,$1,s) {          if ($text =~ s,^((?:.*?[\n\r]){5}).*$,$1,s) {
313                  $text =~ s/[\n\r]*$/ .../;                  $text =~ s/[\n\r]*$/ .../;
# Line 261  sub body_filter { Line 327  sub body_filter {
327          # remove signature          # remove signature
328          if ($text =~ s/([\n\r]+)(--\s*[\n\r]+.*)$//s) {          if ($text =~ s/([\n\r]+)(--\s*[\n\r]+.*)$//s) {
329                  $sig = "$1#-#signature##$2##signature#-#";                  $sig = "$1#-#signature##$2##signature#-#";
330            } elsif ($text =~s/(^|[\n\r]+)*(_____+[\n\r]+.*)$//s) {
331                    $sig = "$1#-#signature##$2##signature#-#";
332          }          }
333    
334          # find quoted text          # find quoted text
335          $text =~ s/^([\>:\|=]+\s*.*?)$/#-#quote##$1##quote#-#/msg;          $text =~ s/^([\>:\|=]+[^\n\r]*[\n\r]*)$/#-#quote1##$1##quote1#-#/mg;
336          $text =~ s/(--+\s*Original\s+Message\s*--+.*)$/#-#quote##$1##quote#-#/si || $text =~ s/(--+\s*Forwarded\s+message\s*from\s+.+\s*--+.*)$/#-#quote##$1##quote#-#/si;          $text =~ s/(--+\s*Original\s+Message\s*--+.*)$/#-#quote2##$1##quote2#-#/si;
337            $text =~ s/(--+\s*Forwarded\s+message.+\s*--+.*)$/#-#quote3##$1##quote3#-#/si;
338    
339          $text = html_escape($text . $sig);          $text = html_escape($text . $sig);
         $text =~ s/#-#(quote|signature)##(.+?)##(\1)#-#/<span class="$1">$2<\/span>/gs;  
340          return $text;          return $text;
341  }  }
342    
Legend:
Removed from v.28  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.26