2 ===================================================================
3 RCS file: /cvsroot/its/sw/wreq/req-mail,v
4 retrieving revision 1.4
5 retrieving revision 1.7
7 --- req-mail 1999/05/15 10:41:24 1.4
8 +++ req-mail 1999/05/19 17:02:41 1.7
11 $body=''; # as description field in req
13 +$mimetype=''; # If this a mime message, place the type here
14 $warn=''; # error message. if set, no auto reply will be sent to sender
15 # carry along the group name if given as the 1st arg to the alias:
16 $group=defined($ARGV[0])?$ARGV[0]:'';
22 + my $prevline = pop(@header);
23 + $_ = $prevline . $_;
31 $header=join "\n",@header;
32 -$body=join "\n",@body;
34 +if (grep(/^MIME-Version: /, @header)) {
35 + my ($typeline) = grep(/^Content-Type: /i, @header);
36 + ($mimetype) = $typeline =~ m/Content-Type:\s+([^;]+)/i;
39 ###parse header for email:
42 ###########################################################
43 }elsif(/^Date:\s+(.*\S)/){ # Date: a b
45 + }elsif(/^Subject:\s+(.*)$/){ # Subject: line
48 ###########################################################
51 if($uid =~ /^(root|diag|sys|adm|lp|nobody|MAILER-DAEMON|postmaster|\
52 daemon|bin|uucp|powerdown)/i){
53 #$warn.=" Not send auto-reply to uid $uid.";
56 +# Unpack MIME subjects
57 +if ( $subject =~ m%=\?([^\?]+)\?Q\?.+\?=% ) {
59 + for $supcharset (@supcharsets) {
60 + if ($charset =~ /$supcharset/i) { # ignore case
61 + $subject =~ s/=\?[^\?]+\?Q\?(.+)\?=/$1/g;
62 + $subject =~ s/_/ /g;
63 + $subject =~ s/=([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
69 +# XXX Should parse/unpack MIME mail here. We only handle text/plain for now.
70 +if ($mimetype && 'text/plain' ne $mimetype) {
71 + # send error back to user
72 + &sendMail("$error_from", "", "$email", "",
73 + "Error in sending your request",
74 + "Your request with subject\n\n$subject\n\n" .
75 + "was NOT included in bug list!\n\n".
76 + "We only handle MIME type text/plain or non-MIME for the moment\n" .
77 + "Please resend your request like that, or use the web form.\n\n" .
83 +if ('' eq $mimetype || 'text/plain' eq $mimetype) {
86 + last if (/^-- $/ && $dropmailsig);
89 + $body=join "\n",@body[0..$bodylines-1];
91 + $body=join "\n",@body;
94 ###send the request to the web server
96 ===================================================================
97 RCS file: /cvsroot/its/sw/wreq/req-config,v
98 retrieving revision 1.5
99 retrieving revision 1.6
101 --- req-config 1999/05/15 11:21:23 1.5
102 +++ req-config 1999/05/19 17:02:41 1.6
104 #### If $sendmail is '', relay mails thru this host
105 $mailhost='mailhost';
107 +#### Set this to '1' to remove signatures (everything from '\n-- \n)
108 +#### in incoming mail and set to '' if you want to keep the signature
111 +#### Supported charsets. Unescape these charsets when MIME encoded in
113 +@supcharsets = ("iso-8859-1", "iso8859-1");
115 #### The From address for errors in processing email requests
116 #### Note: to prevent mail looping, this address doesn't actually exist.
117 $error_from="Support Online Error <req-error\@student.uit.no>";