scripts/receive

   1 #!/usr/bin/perl
   2 # $Id: receive.in,v 1.17 2005/07/24 18:42:41 don Exp $
   3 # usage: mail is piped directly into program
   4
   5 #set umask in order to have group-writable incoming/*
   6 #umask(002);
   7
   8 use Debbugs::Config qw(:globals :text);
   9 my $lib_path = $gLibPath;
  10
  11 $ENV{'PATH'} = '/usr/lib/debbugs:'.$ENV{'PATH'};
  12
  13 #set source of mail delivery
  14 #sets any prefix needed to get mailer to add it to error mail
  15 if ( $gMailer eq 'exim' )
  16 {       $gBadEmailPrefix = '';
  17         $_ = $ENV{'LOCAL_PART'};
  18 } elsif ( $gMailer eq 'qmail' )
  19 {       $gBadEmailPrefix = '//';
  20         $_ = $ENV{'DEFAULT'};
  21 #       $_ = $ENV{'RECIPIENT'};
  22 #       s/^\w+-bugs--?//;
  23 } else
  24 {       $gBadEmailPrefix = '';
  25         $_ = $ARGV[0];
  26         s/\>//;
  27         s/\<//;
  28 }
  29
  30 #remove everything from @ to end of line
  31 s/\@.*$//;
  32
  33 #convert remaining upper case to lower case
  34 y/A-Z/a-z/;
  35
  36 #set up to determine command
  37 %withbugaddressmap= ('-submit',     'B',
  38                    '',            'B',
  39                    '-maintonly',  'M',
  40                    '-quiet',      'Q',
  41                    '-forwarded',  'F',
  42                    '-done',       'D',
  43                    '-close',      'D',
  44                    '-request',    'R',
  45                    '-submitter',  'U',
  46                    # Used for bug subscription
  47                    #'-list-nothing-will-match-this', 'L',
  48                     );
  49
  50 %withpkgaddressmap= ('-request',     'R');
  51
  52 %withoutaddressmap= ('submit',     'B',
  53                       'bugs',       'B',
  54                       'maintonly',  'M',
  55                       'quiet',      'Q',
  56                       'forwarded',  'F',
  57                       'done',       'D',
  58                       'close',      'D',
  59                       'request',    'R',
  60                       'submitter',  'U',
  61                       'control',    'C');
  62
  63 #determine command
  64 if (s/^(\d{1,9})\b//) {
  65     $bugnumber= $1;
  66     if (not exists $withbugaddressmap{$_} and
  67 /-(?:(?:un)?subscribe|subhelp|help|ignore|(?:sub(?:yes|approve|reject)
  68  |unsubyes|bounce|probe|approve|reject|
  69  setlistyes|setlistsilentyes).*)/x
  70        ) {
  71          $map = 'L';
  72     }
  73     else {
  74          $map= $withbugaddressmap{$_};
  75     }
  76     $addrrec= "$bugnumber$_";
  77 } elsif (s/^(\w+)-//) {
  78     $bugnumber= $1;
  79     $map= $withpkgaddressmap{"-$_"};
  80     $addrrec= "$bugnumber-$_";
  81 } else {
  82     $bugnumber= '';
  83     $map= $withoutaddressmap{$_};
  84     $addrrec= "$_";
  85 }
  86
  87 #print no command received
  88 if (!defined($map)) {
  89     print STDERR <<ENDTEXT;
  90 $gBadEmailPrefix
  91 $gBadEmailPrefix Unknown $gBug service address $_\@$gEmailDomain.
  92 $gBadEmailPrefix Recognised addresses are:
  93 $gBadEmailPrefix
  94 $gBadEmailPrefix     General:       Read $gBug# in Subject:    $gBug# is NNNN:
  95 $gBadEmailPrefix
  96 $gBadEmailPrefix      request        submit  $gBug             NNNN  NNNN-submit
  97 $gBadEmailPrefix      control        maintonly                NNNN-maintonly
  98 $gBadEmailPrefix      owner          quiet                    NNNN-quiet
  99 $gBadEmailPrefix      postmaster     forwarded                NNNN-forwarded
 100 $gBadEmailPrefix                     done  close              NNNN-done  NNNN-close
 101 $gBadEmailPrefix                     submitter                NNNN-submitter
 102 $gBadEmailPrefix
 103 $gBadEmailPrefix (all \@$gEmailDomain.)
 104 $gBadEmailPrefix
 105 $gBadEmailPrefix For instructions via the WWW see:
 106 $gBadEmailPrefix   http://$gWebDomain/
 107 $gBadEmailPrefix   http://$gWebDomain/Reporting$gHTMLSuffix
 108 $gBadEmailPrefix   http://$gWebDomain/Developer$gHTMLSuffix
 109 $gBadEmailPrefix   http://$gWebDomain/Access$gHTMLSuffix
 110 $gTextInstructions
 111 $gBadEmailPrefix For details of how to access $gBug report logs by email:
 112 $gBadEmailPrefix   send \`request\@$gEmailDomain' the word \`help'
 113 $gBadEmailPrefix
 114 ENDTEXT
 115     exit(100);
 116 }
 117
 118 @months=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 119 ($sec,$min,$hour,$mday,$mon,$year)= gmtime(time);
 120
 121 $queue= "$map$bugnumber";
 122
 123 chdir("$gSpoolDir/incoming") || &failure("chdir to spool: $!");
 124
 125 $id= time.$$;
 126 open(FILE,">T.$id") || &failure("open temporary file: $!");
 127 printf(FILE "Received: (at %s) by $gEmailDomain; %d %s %d %02d:%02d:%02d +0000\n",
 128        $addrrec, $mday,$months[$mon],$year+1900, $hour,$min,$sec) ||
 129     &failure("write header to temporary file: $!");
 130 while(<STDIN>) { print(FILE) || &failure("write temporary file: $!"); }
 131 close(FILE) || &failure("close temporary file: $!");
 132
 133 my $prefix;
 134 if ($gSpamScan) {
 135     $prefix = 'S';
 136 } else {
 137     $prefix = 'I';
 138 }
 139 rename("T.$id","$prefix$queue.$id") || &failure("rename spool message: $!");
 140
 141 exit(0);
 142
 143 sub failure {
 144     length($id) && unlink("T.$id");
 145     print STDERR "bugs receive failure: @_\n";
 146     exit(75); # EX_TEMPFAIL
 147 }