Sharedwww / cgi-bin / openwebmail / vacation.plOpen in CoCalc
Author: William A. Stein
1
#!/usr/bin/perl
2
#
3
# vacation.pl - vacation program
4
#
5
# Larry Wall <lwall.AT.jpl-devvax.jpl.nasa.gov>
6
# updates by Tom Christiansen <tchrist.AT.convex.com>
7
# updates by Chung-Kie Tung <tung.AT.turtle.ee.ncku.edu.tw>
8
# updates by Scott Mazur <scott.AT.littlefish.ca> - added -p path option
9
#
10
11
#
12
# syntax:
13
#
14
# vacation.pl [ -I|-i ]
15
# init vacation db
16
#
17
# vacation.pl [ -j ] [ -a alias ] [-f ifile] [ -tN ] [-d] [-p homepath] username
18
# used in ~/.forward file to auto-generate reply message
19
#
20
# username A message will be replied only if the username
21
# appears as an recipient in To: or Cc:
22
#
23
# -j Do not check whether the username appears as an
24
# recipient in the To: or the Cc: line.
25
#
26
# -a alias Indicate that alias is one of the valid names of the
27
# username, so the reply will be generated if the alias
28
# appears in To: or Cc:
29
#
30
# -f ifile Specify a file containing ignored users. Mails sent
31
# from the ignored users won't be auto-replied
32
#
33
# -tN Change the interval between repeat replies to the
34
# same sender. The default is 1 week. A trailing
35
# s, m, h, d, or w scales N to seconds, minutes,
36
# hours, days, or weeks respectively.
37
#
38
# -p homepath Specify a directory for the user home.
39
# (mostly for virtual user with no real unix home)
40
#
41
# -d log debug information to /tmp/vacation.debug
42
#
43
# The options -a and -f can be specified for more than one times.
44
#
45
#
46
# .forward file will contain a line of the form:
47
#
48
# \username, "|/usr/local/bin/vacation.pl -t1d username"
49
#
50
# .vacation.msg should include a header with at least Subject: line
51
#
52
# For example:
53
#
54
# Subject: I am on vacation
55
#
56
# I am on vacation until July 22.
57
# If you have something urgent,
58
# please contact cilen ([email protected]).
59
# --tung
60
#
61
# If the string $SUBJECT appears in the .vacation.msg file, it
62
# is replaced with the subject of the original message when
63
# the reply is sent; thus, a .vacation.msg file such as
64
#
65
# Subject: I am on vacation
66
#
67
# I am on vacation until July 22.
68
# Your mail regarding "$SUBJECT" will be read when I return.
69
# If you have something urgent,
70
# please contact cilen ([email protected]).
71
# --tung
72
#
73
# will include the subject of the message in the reply.
74
#
75
76
use strict;
77
foreach (qw(ENV BASH_ENV CDPATH IFS TERM)) {delete $ENV{$_}}; $ENV{PATH}='/bin:/usr/bin'; # secure ENV
78
79
my $myname = $0;
80
if ($myname !~ m!^/! || ! -x $myname) {
81
print "Please execute vacation.pl with full path.\n";
82
exit 1;
83
}
84
85
my $sendmail;
86
if ( -x '/usr/sbin/sendmail') {
87
$sendmail='/usr/sbin/sendmail';
88
} elsif ( -x '/usr/lib/sendmail') {
89
$sendmail='/usr/lib/sendmail';
90
} else {
91
die "Sendmail binary not found";
92
}
93
94
my $usage = qq|Usage: vacation.pl -i\n|.
95
qq| vacation.pl [-j] [-a alias] [-tN] username\n|;
96
97
my $timeout = 7 * 24 * 60 * 60; # unit: second, default 1 week
98
99
my %scale = ( # set-up time scale suffix ratios
100
's', 1,
101
'm', 60,
102
'h', 60 * 60,
103
'd', 24 * 60 * 60,
104
'w', 7 * 24 * 60 * 60,
105
);
106
107
my @ignores = (
108
'daemon',
109
'postmaster',
110
'mailer-daemon',
111
'mailer',
112
'root',
113
);
114
my @aliases = ();
115
116
my ($opt_i, $opt_d, $opt_j, $home_path)=(0,0,0,0);
117
118
########## MAIN ##################################################
119
120
if (defined($ENV{'GATEWAY_INTERFACE'})) { # cgi mode
121
my $clientip=clientip();
122
my $info=$ENV{'HTTP_ACCEPT_LANGUAGE'}; $info.=', ' if ($info ne '');
123
$info.=$ENV{'HTTP_USER_AGENT'}; $info=" ($info)" if ($info ne '');
124
log_debug("$clientip$info is cracking the system by calling vacation.pl as CGI?");
125
sleep 10;
126
die "This program should not be called as CGI!\n";
127
}
128
129
# parse options, handle initialization or interactive mode
130
while (defined($ARGV[0]) && $ARGV[0] =~ /^-/) {
131
$_ = shift;
132
if (/^-I/i) { # eric allman's source has both cases
133
$opt_i=1;
134
} elsif (/^-d/) { # log debug information to /tmp/vacation.debug
135
$opt_d=1;
136
} elsif (/^-j/) { # don't check if user is a valid receiver
137
$opt_j=1;
138
} elsif (/^-f(.*)/) { # read ignorelist from file
139
push(@ignores, read_list_from_file($1 ? $1 : shift));
140
} elsif (/^-a(.*)/) { # specify alias name
141
push(@aliases, $1 ? $1 : shift);
142
} elsif (/^-t([\d.]*)([smhdw])/) { # specify reply once interval
143
$timeout = $1;
144
$timeout *= $scale{$2} if $2;
145
} elsif (/^-p(.*)/) { # use an alternate home path
146
$home_path=$1;
147
} else {
148
die $usage;
149
}
150
}
151
152
if ($opt_i) {
153
log_debug($0, "init mode with arg: ", @ARGV,
154
"ruid=$<, euid=$>, rgid=$(, egid=$)" ) if ($opt_d);
155
init_mode();
156
} elsif (@ARGV) {
157
log_debug($0, "piped mode with arg: ", @ARGV,
158
"ruid=$<, euid=$>, rgid=$(, egid=$)" ) if ($opt_d);
159
push(@ignores, $ARGV[0]);
160
push(@aliases, $ARGV[0]);
161
pipe_mode($ARGV[0]);
162
} else {
163
log_debug($0, "interactive mode(no arg)",
164
"ruid=$<, euid=$>, rgid=$(, egid=$)") if ($opt_d);
165
interactive_mode();
166
}
167
exit 0;
168
169
170
########## INIT MODE #############################################
171
sub init_mode {
172
my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwuid($>))[0];
173
my $uid=(getpwnam($user))[2];
174
if ($uid != $>) {
175
$<=$> if ($>==0);
176
$>=$uid;
177
log_debug("change to $user euid: ruid=$<, euid=$>") if ($opt_d);
178
}
179
my $home = $home_path || $ENV{'HOME'} || (getpwnam($user))[7] or die "No home directory for user $user\n";
180
181
# guess real homedir under automounter
182
$home="/export$home" if ( -d "/export$home" );
183
($home =~ /^(.+)$/) && ($home = $1); # untaint $home...
184
chdir $home or die "Can't chdir to $home: $!\n";
185
186
init_vacation_db();
187
}
188
189
sub init_vacation_db {
190
my %VAC;
191
unlink(".vacation", ".vacation.db", ".vacation.pag", ".vacation.dir");
192
dbmopen(%VAC, ".vacation", 0600) or die "Can't open vacation dbm files: $!\n";
193
%VAC=();
194
dbmclose(%VAC);
195
}
196
197
########## INTERACTIVE MODE ######################################
198
sub interactive_mode {
199
my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || getlogin || (getpwuid($>))[0];
200
my $uid=(getpwnam($user))[2];
201
if ($uid != $>) {
202
$<=$> if ($>==0);
203
$>=$uid;
204
log_debug("change to $user euid: ruid=$<, euid=$>") if ($opt_d);
205
}
206
my $home = $home_path || $ENV{'HOME'} || (getpwnam($user))[7] or die "No home directory for user $user\n";
207
my $editor = $ENV{'VISUAL'} || $ENV{'EDITOR'} || 'vi';
208
my $pager = 'more'; $pager=$ENV{'PAGER'} if (-f $ENV{'PAGER'});
209
210
# guess real homedir under automounter
211
$home="/export$home" if ( -d "/export$home" );
212
($home =~ /^(.+)$/) && ($home = $1); # untaint $home...
213
chdir $home or die "Can't chdir to $home: $!\n";
214
215
print qq|This program can be used to answer your mail automatically\n|,
216
qq|when you go away on vacation.\n|;
217
218
if (-f '.forward') {
219
print "\nYou already have a $home/.forward file containing:\n",
220
"------------------------------------------------------\n",
221
`cat .forward`, "\n",
222
"------------------------------------------------------\n";
223
if (yorn("Would you like to remove it and disable the vacation feature? ")) {
224
my (%VAC, @keys);
225
unlink('.forward') or die "Can't unlink .forward: $!\n";
226
if (dbmopen(%VAC, '.vacation', undef)) {
227
if (@keys = sort { $VAC{$a} <=> $VAC{$b}; } keys %VAC) {
228
require 'ctime.pl';
229
print "While you were away, mail was sent to the following addresses:\n\n";
230
open (PAGER, "|$pager") or die "can't open $pager: $!";
231
foreach (@keys) {
232
my ($when) = unpack("L", $VAC{$_});
233
printf PAGER "%-20s %s", $_, ctime($when);
234
}
235
print PAGER "\n";
236
close PAGER;
237
}
238
dbmclose(%VAC);
239
} else {
240
unlink(".vacation", ".vacation.db", ".vacation.pag", ".vacation.dir");
241
}
242
print "Back to normal reception of mail.\n";
243
} else {
244
print "Ok, vacation feature NOT disabled.\n";
245
}
246
return;
247
}
248
249
if (-f '.vacation.msg') {
250
print "\nYou already have a $home/.vacation.msg containing:\n",
251
"------------------------------------------------------\n",
252
`cat .vacation.msg`, "\n",
253
"------------------------------------------------------\n";
254
if ( yorn("Would you like to edit it? ") ) {
255
system $editor, '.vacation.msg';
256
}
257
} else {
258
create_default_vacation_msg();
259
print qq|\n|,
260
qq|I've created a default vacation message in ~/.vacation.msg.\n|,
261
qq|This message will be automatically returned to anyone sending you mail\n|,
262
qq|while you're out.\n|,
263
qq|\n|,
264
qq|Press return when ready to continue, and you will enter your favorite\n|,
265
qq|editor ($editor) to edit the messasge to your own tastes.\n|;
266
local $| = 1;
267
print "Press return to continue: ";
268
<STDIN>;
269
system $editor, '.vacation.msg';
270
}
271
272
print qq|\nTo enable the vacation feature a ".forward" file will be created.\n|;
273
if (yorn("Would you like to enable the vacation feature now? ")) {
274
init_vacation_db();
275
create_dot_forward($user, $myname) if (! -f ".forward");
276
create_default_vacation_msg() if (! -f ".vacation.msg");
277
print qq|\n|,
278
qq|Ok, vacation feature ENABLED.\n|,
279
qq|Please remember to turn it off when you get back from vacation.\n|,
280
qq|Bon voyage!\n|;
281
} else {
282
print qq|Ok, vacation feature NOT enabled.\n|;
283
}
284
285
return;
286
}
287
288
sub create_dot_forward {
289
my ($user, $vacation)=@_;
290
open(FOR, ">.forward") or die "Can't create .forward: $!\n";
291
print FOR qq!\\$user, "|$vacation $user"\n!;
292
close FOR;
293
return;
294
}
295
296
sub create_default_vacation_msg {
297
open(MSG, ">.vacation.msg") or die "Can't create .vacation.msg: $!\n";
298
print MSG qq|Subject: This is an autoreply...[Re: \$SUBJECT]\n|,
299
qq|\n|,
300
qq|I will not be reading my mail for a while.\n|,
301
qq|Your mail regarding '\$SUBJECT' will be read when I return.\n|;
302
close MSG;
303
return;
304
}
305
306
sub yorn {
307
my $answer;
308
for (;;) {
309
print $_[0]; $answer = <STDIN>;
310
last if $answer =~ /^[yn]/i;
311
print qq|Please answer "yes" or "no" ('y' or 'n')\n|;
312
}
313
return($answer =~ /^y/i);
314
}
315
316
########## PIPE MODE #############################################
317
sub pipe_mode {
318
my $user = $_[0];
319
my ($uid,$home) = (getpwnam($user))[2,7];
320
if ($uid != $>) {
321
$<=$> if ($>==0);
322
$>=$uid;
323
log_debug("change to $user euid: ruid=$<, euid=$>") if ($opt_d);
324
}
325
$home = $home_path if ($home_path);
326
if (!$home) {
327
log_debug("Error! No home directory for user $user\n") if ($opt_d);
328
die "No home directory for user $user\n";
329
}
330
331
# guess real homedir under automounter
332
$home="/export$home" if ( -d "/export$home" );
333
($home =~ /^(.+)$/) && ($home = $1); # untaint $home...
334
if (! chdir $home) {
335
log_debug("Error! Can't chdir to $home: $!\n") if ($opt_d);
336
die "Can't chdir to $home: $!\n";
337
}
338
339
my ($header, $from, $subject, $to, $cc);
340
341
$/ = ''; # paragraph mode, readin until blank line
342
$header = <STDIN>;
343
$header =~ s/\n\s+/ /g; # fix continuation lines
344
$/ = "\n";
345
346
($from) = ($header =~ /^From\s+(\S+)/); # that's the Unix-style From line
347
if ($from eq "") {
348
log_debug("Error! No 'From ' line!\n") if ($opt_d);
349
die "No 'From ' line!\n";
350
}
351
352
if ($header =~ /^Precedence:\s*(bulk|junk)/im || $from =~ /[email protected]/i ) {
353
log_debug("Junk mail, autoreply canceled\n") if ($opt_d);
354
exit 0;
355
}
356
for (@ignores) {
357
if ($from =~ /^$_$/i ) {
358
log_debug("Message from ignored user $_, autoreply canceled\n") if ($opt_d);
359
exit 0;
360
}
361
}
362
363
($subject) = ($header =~ /^Subject: +(.*)$/im);
364
$subject = "(No subject)" unless $subject;
365
$subject =~ s/\s+$//;
366
$subject= decode_mimewords($subject);
367
368
($to) = ($header =~ /^To:\s+(.*)$/im);
369
($cc) = ($header =~ /^Cc:\s+(.*)$/im);
370
$to .= ', '.$cc if $cc;
371
372
if (!$opt_j) {
373
my $found=0;
374
foreach my $name (@aliases) {
375
if ($to =~ /\b$name\b/i) {
376
$found=1; last;
377
}
378
}
379
if (!$found) {
380
log_debug("User", @aliases, "not found in to: and cc:, autoreply canceled\n") if ($opt_d);
381
exit 0;
382
}
383
}
384
385
my (%VAC, $now, $lastdate);
386
$now = time;
387
if (!dbmopen(%VAC, ".vacation", 0600)) {
388
unlink(".vacation", ".vacation.db", ".vacation.pag", ".vacation.dir");
389
dbmopen(%VAC, ".vacation", 0600) or die "Can't open vacation dbm files: $!\n";
390
}
391
$lastdate = $VAC{$from};
392
if ($lastdate ne '') {
393
($lastdate) = unpack("L",$lastdate);
394
if ($lastdate) {
395
if ($now < $lastdate + $timeout) {
396
log_debug("Time too short from last reply, autoreply canceled\n") if ($opt_d);
397
exit 0;
398
}
399
} else { # unpack failed, data format error!
400
log_debug("Error! Invalid data format in .vacation dbm\n") if ($opt_d);
401
exit 1;
402
}
403
}
404
$VAC{$from} = pack("L", $now);
405
dbmclose(%VAC);
406
407
create_default_vacation_msg() if (! -f ".vacation.msg");
408
my $msg;
409
if (open(MSG,'.vacation.msg')) {
410
local $/; undef $/; $msg = <MSG>; # read whole file at once
411
close MSG;
412
}
413
$msg=adjust_replymsg($msg, $from, $subject);
414
415
# remove ' in $from to prevent shell escape
416
$from=~s/'/ /g;
417
418
# open(MAIL, "|$sendmail -oi -t '$from'") or die "Can't run sendmail: $!\n";
419
open(MAIL, "|$sendmail -oi '$from'") or die "Can't run sendmail: $!\n";
420
print MAIL $msg;
421
close MAIL;
422
423
log_debug("Auto reply for message $subject is sent to $from\n") if ($opt_d);
424
}
425
426
sub read_list_from_file {
427
my $file=$_[0];
428
die "File $file doesn't exist!\n" if (! -f "$file");
429
430
my @list=();
431
if ( open(FILE, $file) ) {
432
while (<FILE>) {
433
push(@list, split);
434
}
435
close (FILE);
436
}
437
return(@list);
438
}
439
440
# add proper header to .vacation.msg
441
# it assumes each header in .vacation.msg takes only 1 line
442
sub adjust_replymsg {
443
my ($msg, $from, $subject)=@_;
444
my ($header, $body)=("","");
445
my ($has_subject, $has_to, $has_precedence)=(0,0,0);
446
my $inheader=1;
447
448
foreach (split(/\n/,$msg)) {
449
if ($inheader==0) {
450
$body.="$_\n";
451
next;
452
}
453
if (/^Subject: /i) {
454
$has_subject=1;
455
$header.="$_\n";
456
} elsif (/^To: /i) {
457
$has_to=1;
458
$header.="$_\n";
459
} elsif (/^Precedence: /i) {
460
$has_precedence=1;
461
$header.="$_\n";
462
} elsif (/^[A-Za-z0-9\-]+: /i) {
463
$header.="$_\n";
464
} else {
465
$inheader=0;
466
$body.="$_\n";
467
}
468
}
469
470
if (!$has_to) {
471
$header=qq|To: $from\n|.$header;
472
}
473
if (!$has_subject) {
474
$header=qq|Subject: This is an autoreply...[Re: $subject]\n|.$header;
475
}
476
if (!$has_precedence) {
477
$header=$header.qq|Precedence: junk\n|;
478
}
479
480
if ($body=~/^\n/) {
481
$msg=$header.$body;
482
} else {
483
$msg=$header."\n".$body;
484
}
485
486
# replace '$SUBJECT' token with real subject in original message
487
$msg =~ s/\$SUBJECT/$subject/g; # Sun's vacation does this
488
return($msg);
489
}
490
491
########## MIME and DEBUG routines ###############################
492
493
# decode_mimewords, decode_base64 and _decode_q are blatantly snatched
494
# from parts of the MIME-Base64 Perl modules.
495
sub decode_mimewords {
496
my $encstr = shift;
497
my %params = @_;
498
my @tokens;
499
[email protected] = ''; ### error-return
500
501
### Collapse boundaries between adjacent encoded words:
502
$encstr =~ s{(\?\=)\s*(\=\?)}{$1$2}gs;
503
pos($encstr) = 0;
504
### print STDOUT "ENC = [", $encstr, "]\n";
505
506
### Decode:
507
my ($charset, $encoding, $enc, $dec);
508
while (1) {
509
last if (pos($encstr) >= length($encstr));
510
my $pos = pos($encstr); ### save it
511
512
### Case 1: are we looking at "=?..?..?="?
513
if ($encstr =~ m{\G # from where we left off..
514
=\?([^?]*) # "=?" + charset +
515
\?([bq]) # "?" + encoding +
516
\?([^?]+) # "?" + data maybe with spcs +
517
\?= # "?="
518
}xgi) {
519
($charset, $encoding, $enc) = ($1, lc($2), $3);
520
$dec = (($encoding eq 'q') ? _decode_Q($enc) : _decode_B($enc));
521
push @tokens, [$dec, $charset];
522
next;
523
}
524
525
### Case 2: are we looking at a bad "=?..." prefix?
526
### We need this to detect problems for case 3, which stops at "=?":
527
pos($encstr) = $pos; # reset the pointer.
528
if ($encstr =~ m{\G=\?}xg) {
529
[email protected] .= qq|unterminated "=?..?..?=" in "$encstr" (pos $pos)\n|;
530
push @tokens, ['=?'];
531
next;
532
}
533
534
### Case 3: are we looking at ordinary text?
535
pos($encstr) = $pos; # reset the pointer.
536
if ($encstr =~ m{\G # from where we left off...
537
([\x00-\xFF]*? # shortest possible string,
538
\n*) # followed by 0 or more NLs,
539
(?=(\Z|=\?)) # terminated by "=?" or EOS
540
}xg) {
541
length($1) or die "mime: empty token";
542
push @tokens, [$1];
543
next;
544
}
545
546
### Case 4: bug!
547
die "mime: unexpected case:\n($encstr) pos $pos";
548
}
549
return (wantarray ? @tokens : join('',map {$_->[0]} @tokens));
550
}
551
552
sub _decode_B {
553
local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
554
555
my $str = shift;
556
my $res = "";
557
558
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
559
$str =~ s/=+$//; # remove padding
560
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
561
while ($str =~ /(.{1,60})/gs) {
562
my $len = chr(32 + length($1)*3/4); # compute length byte
563
$res .= unpack("u", $len . $1 ); # uudecode
564
}
565
$res;
566
}
567
568
sub _decode_Q {
569
my $str = shift;
570
$str =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; # RFC-1522, Q rule 1
571
$str =~ s/_/\x20/g; # RFC-1522, Q rule 2
572
$str;
573
}
574
575
sub clientip {
576
my $clientip;
577
if (defined($ENV{'HTTP_CLIENT_IP'})) {
578
$clientip=$ENV{'HTTP_CLIENT_IP'};
579
} elsif (defined($ENV{'HTTP_X_FORWARDED_FOR'}) &&
580
$ENV{'HTTP_X_FORWARDED_FOR'} !~ /^(?:10\.|172\.(?:1[6-9]|2[0-9]|3[0-1])\.|192\.168\.|127\.0\.)/ ) {
581
$clientip=(split(/,/,$ENV{'HTTP_X_FORWARDED_FOR'}))[0];
582
} else {
583
$clientip=$ENV{'REMOTE_ADDR'}||"127.0.0.1";
584
}
585
return $clientip;
586
}
587
588
sub log_debug {
589
my @msg=@_;
590
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
591
my ($today, $time);
592
593
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime;
594
$today=sprintf("%4d%02d%02d", $year+1900, $mon+1, $mday);
595
$time=sprintf("%02d%02d%02d",$hour,$min, $sec);
596
597
open(Z, ">> /tmp/vacation.debug");
598
599
# unbuffer mode
600
select(Z); local $| = 1;
601
select(STDOUT);
602
603
print Z "$today $time ", join(" ",@msg), "\n";
604
close(Z);
605
606
chmod(0666, "/tmp/vacation.debug");
607
}
608
609