]> git.donarmstrong.com Git - debbugs.git/blob - scripts/receive
Fix POD error in Debbugs::Mime
[debbugs.git] / 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   $gWebDomain/
107 $gBadEmailPrefix   $gWebDomain/Reporting$gHTMLSuffix
108 $gBadEmailPrefix   $gWebDomain/Developer$gHTMLSuffix
109 $gBadEmailPrefix   $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 }