webstump/scripts/file-message.pl

   1 #!/usr/bin/perl
   2 #
   3 # This script reads a message from stdin, figures out which newsgroup's
   4 # queue it should be saved to, and saves it.
   5 #
   6 #
   7 # Figure out the home directory
   8 #
   9
  10 umask 007;
  11
  12 if( !($0 =~ /\/scripts\/file-message\.pl$/) ) {
  13   die "This script can only be called with full path name!!!";
  14 }
  15
  16 $webstump_home = $0;
  17 $webstump_home =~ s/\/scripts\/file-message\.pl$//;
  18
  19 open STDOUT, ">> $webstump_home/../errs" or die $!;
  20 open STDERR, ">&STDOUT" or die $!;
  21
  22 require "$webstump_home/config/webstump.cfg";
  23 require "$webstump_home/scripts/webstump.lib.pl";
  24 require "$webstump_home/scripts/filter.lib.pl";
  25 require "$webstump_home/scripts/mime-parsing.lib";
  26
  27 &init_webstump;
  28
  29 $time = time;
  30 $directory = "$webstump_home/tmp/dir_$time" . "_$$";
  31
  32 while( <STDIN> )
  33 {
  34   chop;
  35   if( /^X-Moderate-For: / ) {
  36     s/^X-Moderate-For: //;
  37     $newsgroup = $_;
  38   } elsif ( /^Subject: / ) {
  39     $Subject = $_;
  40   } elsif ( /^$/ ) {
  41     last;
  42   }
  43 }
  44
  45 die
  46 "This message did not look like it came from STUMP because it did not
  47 contain the X-Moderate-For: header"
  48         if( !$newsgroup );
  49
  50 while( ($_ = <STDIN>) && !($_ =~ /^\@+$/ )) {};
  51
  52 #
  53 # this will also take away the "From " line.
  54 #
  55 while( ($_ = <STDIN>) && ($_ =~ /^$/ )) {};
  56
  57 my ($entity, $prolog);
  58
  59 if( $use_mime eq "yes" ) {
  60   ($entity, $prolog) = &decode_mime_message( $directory );
  61 } else { # no MIME
  62   $prolog = &decode_plaintext_message( $directory );
  63 }
  64
  65 $prolog = $Subject . "\n" . $prolog;
  66
  67 die "This message did not look like it came from STUMP because it did not
  68     contain the X-Moderate-For: header"
  69         if( !$newsgroup );
  70
  71 $queue_dir = &getQueueDir( $newsgroup )
  72         || die "Newsgroup $newsgroup is not listed in the newsgroups database";
  73
  74 mkdir $queue_dir, 0755; # it is OK if this fails
  75 chmod 0755, $queue_dir;
  76
  77 die "$queue_dir does not exist or is not writable"
  78         if( ! -d $queue_dir || ! -w $queue_dir );
  79
  80 open( PROLOG, ">$directory/stump-prolog.txt" ) or die $!;
  81 print PROLOG $prolog or die $!;
  82 close( PROLOG ) or die $!;
  83
  84 #open( FULL, ">$directory/full_message.txt" );
  85 #print FULL $entity->as_string;
  86 #close( FULL );
  87
  88 my $dir = "dir_$time" . "_$$";
  89 rename $directory, "$queue_dir/$dir" or die $!;
  90
  91 &init_webstump;
  92 $request{"newsgroup"} = $newsgroup;
  93
  94 #sub review_incoming_message { # Newsgroup, From, Subject, Message, Dir
  95
  96 &review_incoming_message( $newsgroup, $Article_From, $Subject,
  97                           $Article_Subject, $Article_Head . $Article_Body, $dir );