home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume30 / mserv-3.0 / part02 / dr_mail.pl < prev    next >
Encoding:
Text File  |  1992-06-19  |  7.0 KB  |  283 lines
  1. # dr_mail.pl -- handle request via email
  2. # SCCS Status     : @(#)@ dr_mail.pl    3.1
  3. # Author          : Johan Vromans
  4. # Created On      : Thu Jun  4 22:22:20 1992
  5. # Last Modified By: Johan Vromans
  6. # Last Modified On: Thu Jun  4 23:06:48 1992
  7. # Update Count    : 8
  8. # Status          : OK
  9.  
  10. sub mail_request {
  11.  
  12.     local ($rcpt, $address, $request, $file, $encoding, $limit, $parts) = @_;
  13.  
  14.     if ( $opt_debug ) {
  15.     print STDERR ("&mail_request(rcpt=$rcpt, address=$address, ",
  16.               "request=$request,\n",
  17.               "    file=$file,\n",
  18.               "    encoding=$encoding, limit=$limit, parts=$parts)\n");
  19.     }
  20.  
  21.     # This routine handles the requests.
  22.     # Handling includes encoding, splitting and transmitting.
  23.  
  24.     &check_file ($file, 0);
  25.  
  26.     local ($fname);        # Basename of file to send
  27.     local ($cmd);        # Command to handle encoding
  28.     local ($code);        # Verbose description of encoding
  29.     local ($files);        # Number of files to send
  30.     local (@files);        # List of files to send
  31.     local ($the_file);        # Current part be send
  32.     local ($the_part);        # Sequence number thereof
  33.     local ($size);        # Size of chunk
  34.     local ($tmpfile_prefix) = $opt_keep || "$tmpdir/drq$$.";
  35.     local ($Dtmpdir);        # Private dir for Dumas uue
  36.     local ($opt_nolog) = $opt_nolog;
  37.     local ($opt_keep) = $opt_keep;
  38.  
  39.     if ( $address eq "" || $address eq "-" ) {
  40.     # Use this e.g. to include an encoded archive in email.
  41.     $limit = "0";
  42.     $opt_nolog = 1;        # Local.
  43.     $address = "";
  44.     }
  45.     $limit = 32*1024 if $limit eq "";
  46.     if ( $limit ne "0" ) {
  47.     # Limit must be between 10 and 256K, with 32K default.
  48.     $limit =  $`*1024 if $limit =~ /K$/;
  49.     $limit =  10*1024 if $limit <  10*1024;
  50.     $limit = 256*1024 if $limit > 256*1024;
  51.     }
  52.     print STDERR ("Using limit = $limit\n") if $opt_debug;
  53.  
  54.     $encoding = $default_encoding unless defined $encoding;
  55.  
  56.     # Get dir and basename of the requested file.
  57.     local ($dir, $fname) = &fnsplit ($file);
  58.  
  59.     # Prepare the command to use.
  60.     # The result of command should be the encoded file, written
  61.     # to standard output.
  62.  
  63.     if ( $encoding =~ /^u/i ) {
  64.  
  65.     # Standard UU encoding.
  66.     $encoding = "U";
  67.     $code = "uuencoded";
  68.     $cmd = "$uuencode $file '$fname'";
  69.     }
  70.     elsif ( $encoding =~ /^x/i ) {
  71.  
  72.     # Modified UU encoding.
  73.     $encoding = "X";
  74.     $code = "xxencoded";
  75.     $cmd = "$xxencode $file '$fname'";
  76.     }
  77.     elsif ( $encoding =~ /^d/i ) {
  78.  
  79.     # Dumas' modified UU encoding.
  80.     # Uue has a built-in facility to generate multi-part
  81.     # files. The customer wants to use this feature...
  82.     local ($split) = '';
  83.     $encoding = "D";
  84.     $code = "uue-encoded";
  85.     $split = '-' . (int ($limit / 63) - 2) if $limit;
  86.  
  87.     # Prepare a private directory for uue to work in.
  88.     $Dtmpdir = "$tmpdir/D$$";
  89.     &system ("rm -fr $Dtmpdir");
  90.     &system ("mkdir $Dtmpdir");
  91.     &symlink ($file, "$Dtmpdir/$fname");
  92.     $cmd = "cd $Dtmpdir; $uue $split '$fname'";
  93.     }
  94.     elsif ( $encoding =~ /^[pa]/i || $encoding eq "" ) {
  95.     
  96.     # No decoding.
  97.     $encoding = "A";
  98.     $code = "ascii";
  99.     $cmd = "";
  100.     }
  101.     else {
  102.  
  103.     # Binary-to-Ascii encoding.
  104.     $encoding = "B";
  105.     $code = "btoa encoded";
  106.     $cmd = "$btoa < $file";
  107.     }
  108.     print STDERR ("Using encoding = $encoding ($code)\n") if $opt_debug;
  109.  
  110.     if ( $encoding eq "A" && ($limit == 0 || (-s $file <= $limit)) ) {
  111.     # A simple ascii file smaller than $limit -> use it.
  112.     @files = ($file);
  113.     $opt_keep = 1;        # Local copy!
  114.     }
  115.     elsif ( $encoding eq "D" ) {
  116.     local ($path) = ($Dtmpdir);
  117.  
  118.     # Encode and split.
  119.     &system ($cmd);
  120.  
  121.     # Now gather all the parts, and tally them.
  122.     opendir (DIR, $path)
  123.         || &die ("Cannot read $path/ [$!]");
  124.     @files = sort (grep (/\.u[a-z][a-z]$/o, readdir (DIR)));
  125.     close (DIR);
  126.     foreach ( @files ) {
  127.         # Note: $_ is a *ref* into @files!
  128.         $_ = "$path/$_";
  129.     }
  130.     }
  131.     else {
  132.     # It is tempting to use 'split' to cut the request into
  133.     # pieces. Until recently, I did.
  134.     # Splitting ourselves makes it possible to split ascii files
  135.     # also. In this case we can spare another process.
  136.     local ($suffix) = "aa";
  137.     local ($size) = $limit + 1;
  138.  
  139.     if ( $cmd ) {
  140.         print STDERR ("+ $cmd|\n") if $opt_trace;
  141.         open (FEED, "$cmd|")
  142.         || die ("Error opening pipe \"$cmd|\" [$!]\n");
  143.     }
  144.     else {
  145.         print STDERR ("+ <$file\n") if $opt_trace;
  146.         open (FEED, "$file")
  147.         || die ("Error opening file \"$file\" [$!]\n");
  148.     }
  149.  
  150.     @files = ();
  151.     while ( <FEED> ) {
  152.         if ( $limit > 0 && ($size += length ($_)) > $limit ) {
  153.         close (OUT);
  154.         open (OUT, ">$tmpfile_prefix$suffix")
  155.             || die ("Cannot create $tmpfile_prefix$suffix: [$!]\n");
  156.         push (@files, "$tmpfile_prefix$suffix");
  157.         $size = length ($_);
  158.         $suffix++;
  159.         }
  160.         print OUT;
  161.     }
  162.     close (OUT);
  163.     close (FEED);
  164.     }
  165.  
  166.     $files = @files;
  167.  
  168.     if ( $opt_debug ) {
  169.     if ( $files > 1 ) {
  170.         print STDERR ("Sending ", $files, " files: ",
  171.               $files[0], " .. ", $files[$#files], "\n");
  172.     }
  173.     elsif ( $files == 1 ) {
  174.         print STDERR ("Sending file: ", $files[0], "\n");
  175.     }
  176.     else {
  177.         printf STDERR ("No files to send.\n");
  178.     }    
  179.     }
  180.  
  181.     $the_part = 0;
  182.     foreach $the_file ( @files ) {
  183.  
  184.     $the_part++;
  185.  
  186.     if ( $parts && $parts !~ /\b$the_part\b/ ) {
  187.         unlink ($the_file) unless $opt_keep;
  188.         print STDERR ("Skipping part $the_part (not requested).\n")
  189.         if $opt_debug;
  190.         next;
  191.     }
  192.     else {
  193.         print STDERR ("Sending part $the_part of $files.\n")
  194.         if $opt_debug;
  195.     }
  196.  
  197.     # Form "part xx of yy" message.
  198.     $part = ( $files == 1 ) ? "complete" : "part $the_part of $files";
  199.  
  200.     # Send it.
  201.     if ( open (PART, $the_file) ) {
  202.         if ( $address eq "" ) {
  203.         $size = © (*STDOUT);
  204.         }
  205.         else {
  206.         # Suppress sleep after the last part.
  207.         local ($mailer_delay) = $mailer_delay;
  208.         undef $mailer_delay if $the_part == $files;
  209.         $size = &xfer;
  210.         }
  211.         close (PART);
  212.     }
  213.  
  214.     # Write a log message.
  215.     &writelog ("M \"$address\" $request $encoding$the_part/$files $size")
  216.         if $address ne "";
  217.  
  218.     unlink ($the_file) unless $opt_keep;
  219.     }
  220.  
  221.     &system ("rm -fr $Dtmpdir") if $encoding eq "D" && !$opt_keep;
  222. }
  223.  
  224. sub headers {
  225.     local (*FILE, $full) = @_;
  226.  
  227.     # Provide some RFC822 compliant headers.
  228.  
  229.     local ($size) = 0;
  230.  
  231.     if ( defined $sender ) {
  232.     print FILE "$sender\n";
  233.     $size += length ($sender) + 1;
  234.     }
  235.  
  236.     $ln = "To: $address\n";
  237.     $ln .= "Subject: $fname ($part) $code\n";
  238.     $ln .= "Precedence: bulk\n";
  239.     $ln .= join ("\n", @x_headers) . "\n" if defined @x_headers;
  240.     print FILE ($ln, "\n");
  241.     $size += length ($ln) + 1;
  242. }
  243.  
  244. sub copy {
  245.     local (*FILE) = shift (@_);
  246.     local ($size);
  247.     local ($ln);
  248.  
  249.     $ln = "Request: $request\n\n".
  250.     "------ begin of $fname -- $code -- $part ------\n";
  251.     $size = length ($ln);
  252.     print FILE $ln;
  253.     while ( <PART> ) {
  254.     print FILE $_;
  255.     $size += length ($_);
  256.     }
  257.     $ln = "------ end of $fname -- $code -- $part ------\n";
  258.     print FILE $ln;
  259.     $size + length ($ln);
  260. }
  261.  
  262. sub xfer {
  263.  
  264.     # Send the file via e-mail.
  265.     local ($size);
  266.  
  267.     if ( $opt_nomail ) {
  268.     print STDERR "[Would call \"$chunkmail\"]\n";
  269.     &headers (*STDOUT, 0);
  270.     }
  271.     elsif ( open (MAILER, "|$chunkmail '$address'") ) {
  272.     $size = &headers (*MAILER, 0);
  273.     $size += © (*MAILER);
  274.     close MAILER;
  275.  
  276.     # Allow system to stabilize.
  277.     sleep ($mailer_delay) if defined $mailer_delay;
  278.     }
  279.     $size;
  280. }
  281.  
  282. 1;
  283.