Gecko [ thearyasamaj.org ]

Name	Size	Permission
help	[ DIR ]	drwxr-xr-x
images	[ DIR ]	drwxr-xr-x
lang	[ DIR ]	drwxr-xr-x
CHANGELOG	4.2 KB	-rw-r--r--
access-lib.pl	6.41 KB	-rwxr-xr-x
acl_security.pl	9.7 KB	-rwxr-xr-x
aliases-lib.pl	7.93 KB	-rwxr-xr-x
autoreply.pl	12.19 KB	-rwxr-xr-x
backup_config.pl	1.48 KB	-rwxr-xr-x
boxes-lib.pl	80.12 KB	-rwxr-xr-x
build.cgi	1.84 KB	-rwxr-xr-x
cgi_args.pl	1.42 KB	-rwxr-xr-x
config-AlmaLinux-7.0-ALL	685 B	-rw-r--r--
config-Amazon-Linux-2-ALL	685 B	-rw-r--r--
config-CentOS-Linux-7.0-ALL	685 B	-rw-r--r--
config-CentOS-Stream-Linux-8.0...	685 B	-rw-r--r--
config-Oracle-Linux-8.0-ALL	685 B	-rw-r--r--
config-Redhat-Enterprise-Linux...	685 B	-rw-r--r--
config-Rocky-Linux-7.0-ALL	685 B	-rw-r--r--
config-Scientific-Linux-7.0-AL...	685 B	-rw-r--r--
config-aix	573 B	-rw-r--r--
config-cobalt-linux	669 B	-rw-r--r--
config-coherent-linux	661 B	-rw-r--r--
config-corel-linux	528 B	-rw-r--r--
config-debian-linux	607 B	-rw-r--r--
config-debian-linux-2.1-2.2	612 B	-rw-r--r--
config-debian-linux-3.0-ALL	616 B	-rw-r--r--
config-freebsd	654 B	-rw-r--r--
config-freebsd-4.0-ALL	659 B	-rw-r--r--
config-generic-linux	672 B	-rw-r--r--
config-gentoo-linux	697 B	-rw-r--r--
config-hpux	525 B	-rw-r--r--
config-irix	668 B	-rw-r--r--
config-macos	657 B	-rw-r--r--
config-macos-1.3-ALL	662 B	-rw-r--r--
config-mandrake-linux	678 B	-rw-r--r--
config-mandrake-linux-8.2	661 B	-rw-r--r--
config-mandrake-linux-9.0-ALL	678 B	-rw-r--r--
config-msc-linux	576 B	-rw-r--r--
config-netbsd	639 B	-rw-r--r--
config-open-linux	671 B	-rw-r--r--
config-open-linux-2.5	676 B	-rw-r--r--
config-open-linux-3.1e	676 B	-rw-r--r--
config-openSUSE-Linux-15.0-ALL	636 B	-rw-r--r--
config-openbsd	640 B	-rw-r--r--
config-openserver	572 B	-rw-r--r--
config-osf1	538 B	-rw-r--r--
config-redhat-linux	654 B	-rw-r--r--
config-redhat-linux-10.0-23.0	685 B	-rw-r--r--
config-redhat-linux-24.0-ALL	747 B	-rw-r--r--
config-redhat-linux-7.1-7.3	656 B	-rw-r--r--
config-redhat-linux-7.4-9.0	661 B	-rw-r--r--
config-slackware-linux	523 B	-rw-r--r--
config-slackware-linux-8.0	672 B	-rw-r--r--
config-slackware-linux-8.1-ALL	699 B	-rw-r--r--
config-sol-linux	679 B	-rw-r--r--
config-solaris	641 B	-rw-r--r--
config-solaris-10-ALL	722 B	-rw-r--r--
config-solaris-7	730 B	-rw-r--r--
config-solaris-8-9	729 B	-rw-r--r--
config-suse-linux	592 B	-rw-r--r--
config-suse-linux-8.2-ALL	640 B	-rw-r--r--
config-turbo-linux	654 B	-rw-r--r--
config-united-linux	592 B	-rw-r--r--
config-unixware	566 B	-rw-r--r--
config.info	2.4 KB	-rw-r--r--
config.info.ca	2.78 KB	-rw-r--r--
config.info.cs	2.6 KB	-rw-r--r--
config.info.de	2.79 KB	-rw-r--r--
config.info.es	1.74 KB	-rw-r--r--
config.info.fr	2.42 KB	-rw-r--r--
config.info.hu	0 B	-rw-r--r--
config.info.nl	2.72 KB	-rw-r--r--
config.info.no	2.52 KB	-rw-r--r--
config.info.pl	1.13 KB	-rw-r--r--
config.info.pt_BR	2.85 KB	-rw-r--r--
config.info.ru	2.45 KB	-rw-r--r--
config.info.sv	1.06 KB	-rw-r--r--
config.info.tr	1.09 KB	-rw-r--r--
config.info.uk	2.48 KB	-rw-r--r--
config.info.zh	970 B	-rw-r--r--
config.info.zh_TW	1.04 KB	-rw-r--r--
create_file.cgi	1.41 KB	-rwxr-xr-x
defaultacl	286 B	-rw-r--r--
defines	3.77 KB	-rw-r--r--
del_mailq.cgi	1.31 KB	-rwxr-xr-x
del_mailqs.cgi	2.82 KB	-rwxr-xr-x
delete_access.cgi	782 B	-rwxr-xr-x
delete_aliases.cgi	800 B	-rwxr-xr-x
delete_domains.cgi	710 B	-rwxr-xr-x
delete_generics.cgi	790 B	-rwxr-xr-x
delete_mailers.cgi	713 B	-rwxr-xr-x
delete_virtusers.cgi	799 B	-rwxr-xr-x
domain-lib.pl	4.25 KB	-rwxr-xr-x
dontblames	3.34 KB	-rw-r--r--
edit_access.cgi	505 B	-rwxr-xr-x
edit_afile.cgi	1.08 KB	-rwxr-xr-x
edit_alias.cgi	470 B	-rwxr-xr-x
edit_domain.cgi	433 B	-rwxr-xr-x
edit_feature.cgi	2.98 KB	-rwxr-xr-x
edit_ffile.cgi	2.05 KB	-rwxr-xr-x
edit_file.cgi	2.26 KB	-rwxr-xr-x
edit_generic.cgi	460 B	-rwxr-xr-x
edit_mailer.cgi	435 B	-rwxr-xr-x
edit_rfile.cgi	3.05 KB	-rwxr-xr-x
edit_virtuser.cgi	473 B	-rwxr-xr-x
features-lib.pl	4.25 KB	-rwxr-xr-x
feedback_files.pl	397 B	-rwxr-xr-x
filter.pl	1.99 KB	-rwxr-xr-x
flushq.cgi	714 B	-rwxr-xr-x
generics-lib.pl	4.52 KB	-rwxr-xr-x
index.cgi	4.81 KB	-rwxr-xr-x
install_check.pl	452 B	-rwxr-xr-x
list_access.cgi	3.04 KB	-rwxr-xr-x
list_aliases.cgi	3.48 KB	-rwxr-xr-x
list_cgs.cgi	636 B	-rwxr-xr-x
list_cws.cgi	706 B	-rwxr-xr-x
list_domains.cgi	2.36 KB	-rwxr-xr-x
list_features.cgi	2.97 KB	-rwxr-xr-x
list_generics.cgi	3.83 KB	-rwxr-xr-x
list_mailers.cgi	2.66 KB	-rwxr-xr-x
list_mailq.cgi	3.54 KB	-rwxr-xr-x
list_masq.cgi	1.15 KB	-rwxr-xr-x
list_opts.cgi	4.91 KB	-rwxr-xr-x
list_ports.cgi	2.2 KB	-rwxr-xr-x
list_relay.cgi	938 B	-rwxr-xr-x
list_trusts.cgi	646 B	-rwxr-xr-x
list_us	1 B	-rw-r--r--
list_virtusers.cgi	3.75 KB	-rwxr-xr-x
log_parser.pl	1.73 KB	-rwxr-xr-x
mailers-lib.pl	5.32 KB	-rwxr-xr-x
mailq_search.cgi	996 B	-rwxr-xr-x
manual_features.cgi	398 B	-rwxr-xr-x
module.info	646 B	-rw-r--r--
module.info.af	0 B	-rw-r--r--
module.info.af.auto	129 B	-rw-r--r--
module.info.ar	0 B	-rw-r--r--
module.info.ar.auto	217 B	-rw-r--r--
module.info.be	0 B	-rw-r--r--
module.info.be.auto	218 B	-rw-r--r--
module.info.bg	0 B	-rw-r--r--
module.info.bg.auto	230 B	-rw-r--r--
module.info.ca	144 B	-rw-r--r--
module.info.ca.auto	24 B	-rw-r--r--
module.info.cs	30 B	-rw-r--r--
module.info.cs.auto	122 B	-rw-r--r--
module.info.da	0 B	-rw-r--r--
module.info.da.auto	137 B	-rw-r--r--
module.info.de	130 B	-rw-r--r--
module.info.de.auto	17 B	-rw-r--r--
module.info.el	0 B	-rw-r--r--
module.info.el.auto	296 B	-rw-r--r--
module.info.es	35 B	-rw-r--r--
module.info.es.auto	134 B	-rw-r--r--
module.info.eu	0 B	-rw-r--r--
module.info.eu.auto	150 B	-rw-r--r--
module.info.fa	0 B	-rw-r--r--
module.info.fa.auto	229 B	-rw-r--r--
module.info.fi	0 B	-rw-r--r--
module.info.fi.auto	164 B	-rw-r--r--
module.info.fr	34 B	-rw-r--r--
module.info.fr.auto	133 B	-rw-r--r--
module.info.he	0 B	-rw-r--r--
module.info.he.auto	173 B	-rw-r--r--
module.info.hr	0 B	-rw-r--r--
module.info.hr.auto	161 B	-rw-r--r--
module.info.hu	37 B	-rw-r--r--
module.info.hu.auto	129 B	-rw-r--r--
module.info.it	0 B	-rw-r--r--
module.info.it.auto	161 B	-rw-r--r--
module.info.ja	27 B	-rw-r--r--
module.info.ja.auto	143 B	-rw-r--r--
module.info.ko	24 B	-rw-r--r--
module.info.ko.auto	141 B	-rw-r--r--
module.info.lt	0 B	-rw-r--r--
module.info.lt.auto	173 B	-rw-r--r--
module.info.lv	0 B	-rw-r--r--
module.info.lv.auto	169 B	-rw-r--r--
module.info.ms	127 B	-rw-r--r--
module.info.ms.auto	21 B	-rw-r--r--
module.info.mt	0 B	-rw-r--r--
module.info.mt.auto	142 B	-rw-r--r--
module.info.nl	30 B	-rw-r--r--
module.info.nl.auto	108 B	-rw-r--r--
module.info.no	31 B	-rw-r--r--
module.info.no.auto	113 B	-rw-r--r--
module.info.pl	31 B	-rw-r--r--
module.info.pl.auto	122 B	-rw-r--r--
module.info.pt	35 B	-rw-r--r--
module.info.pt.auto	122 B	-rw-r--r--
module.info.pt_BR	39 B	-rw-r--r--
module.info.pt_BR.auto	128 B	-rw-r--r--
module.info.ro	0 B	-rw-r--r--
module.info.ro.auto	144 B	-rw-r--r--
module.info.ru	42 B	-rw-r--r--
module.info.ru.auto	214 B	-rw-r--r--
module.info.sk	0 B	-rw-r--r--
module.info.sk.auto	146 B	-rw-r--r--
module.info.sl	0 B	-rw-r--r--
module.info.sl.auto	153 B	-rw-r--r--
module.info.sv	32 B	-rw-r--r--
module.info.sv.auto	104 B	-rw-r--r--
module.info.th	0 B	-rw-r--r--
module.info.th.auto	294 B	-rw-r--r--
module.info.tr	35 B	-rw-r--r--
module.info.tr.auto	131 B	-rw-r--r--
module.info.uk	0 B	-rw-r--r--
module.info.uk.auto	228 B	-rw-r--r--
module.info.ur	0 B	-rw-r--r--
module.info.ur.auto	233 B	-rw-r--r--
module.info.vi	0 B	-rw-r--r--
module.info.vi.auto	156 B	-rw-r--r--
module.info.zh	24 B	-rw-r--r--
module.info.zh.auto	93 B	-rw-r--r--
module.info.zh_TW	27 B	-rw-r--r--
module.info.zh_TW.auto	99 B	-rw-r--r--
move.cgi	559 B	-rwxr-xr-x
negativeacl	8 B	-rw-r--r--
prefs.info	147 B	-rw-r--r--
qdetach.cgi	1.05 KB	-rwxr-xr-x
rbac-mapping	186 B	-rw-r--r--
save_access.cgi	1.98 KB	-rwxr-xr-x
save_afile.cgi	580 B	-rwxr-xr-x
save_alias.cgi	4.12 KB	-rwxr-xr-x
save_cgs.cgi	640 B	-rwxr-xr-x
save_cws.cgi	678 B	-rwxr-xr-x
save_domain.cgi	1.37 KB	-rwxr-xr-x
save_feature.cgi	2.32 KB	-rwxr-xr-x
save_ffile.cgi	860 B	-rwxr-xr-x
save_file.cgi	3.02 KB	-rwxr-xr-x
save_generic.cgi	1.57 KB	-rwxr-xr-x
save_mailer.cgi	1.83 KB	-rwxr-xr-x
save_masq.cgi	1.2 KB	-rwxr-xr-x
save_opts.cgi	3.29 KB	-rwxr-xr-x
save_ports.cgi	2.47 KB	-rwxr-xr-x
save_relay.cgi	710 B	-rwxr-xr-x
save_rfile.cgi	1.25 KB	-rwxr-xr-x
save_trusts.cgi	589 B	-rwxr-xr-x
save_virtuser.cgi	2.81 KB	-rwxr-xr-x
sendmail-lib.pl	17.76 KB	-rwxr-xr-x
start.cgi	248 B	-rwxr-xr-x
stop.cgi	276 B	-rwxr-xr-x
useradmin_update.pl	1.43 KB	-rwxr-xr-x
view_mailq.cgi	3.91 KB	-rwxr-xr-x
virtusers-lib.pl	6.22 KB	-rwxr-xr-x

Code Editor : autoreply.pl

#!/usr/bin/perl
# autoreply.pl
# Simple autoreply script. Command line arguments are :
# autoreply-file username alternate-file

# Read sendmail module config
$ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin";
$p = -l $0 ? readlink($0) : $0;
$p =~ /^(.*)\/[^\/]+$/;
$moddir = $1;
%config = &read_config_file("$moddir/config");

# If this isn't the sendmail module, try it
if (!$config{'sendmail_path'} || !-x $config{'sendmail_path'}) {
	$moddir =~ s/([^\/]+)$/sendmail/;
	%config = &read_config_file("$moddir/config");
	}

if (!$config{'sendmail_path'} || !-x $config{'sendmail_path'}) {
	# Make some guesses about sendmail
	if (-x "/usr/sbin/sendmail") {
		%config = ( 'sendmail_path' => '/usr/sbin/sendmail' );
		}
	elsif (-x "/usr/local/sbin/sendmail") {
		%config = ( 'sendmail_path' => '/usr/local/sbin/sendmail' );
		}
	elsif (-x "/opt/csw/lib/sendmail") {
		%config = ( 'sendmail_path' => '/opt/csw/lib/sendmail' );
		}
	elsif (-x "/usr/lib/sendmail") {
		%config = ( 'sendmail_path' => '/usr/lib/sendmail' );
		}
	else {
		die "Failed to find sendmail or config file";
		}
	}

# read headers and body
$lnum = 0;
while(<STDIN>) {
	$headers .= $_;
	s/\r|\n//g;
	if (/^From\s+(\S+)/ && $lnum == 0) {
		# Magic From line
		$fromline = $1;
		}
	elsif (/^(\S+):\s+(.*)/) {
		$header{lc($1)} = $2;
		$lastheader = lc($1);
		}
	elsif (/^\s+(.*)/ && $lastheader) {
		$header{$lastheader} .= $_;
		}
	elsif (!$_) { last; }
	$lnum++;
	}
while(<STDIN>) {
	$body .= $_;
	}
if ($header{'x-webmin-autoreply'} ||
    $header{'auto-submitted'} && lc($header{'auto-submitted'}) ne 'no') {
	print STDERR "Cancelling autoreply to an autoreply\n";
	exit 0;
	}
if ($header{'x-spam-flag'} =~ /^Yes/i || $header{'x-spam-status'} =~ /^Yes/i) {
        print STDERR "Cancelling autoreply to message already marked as spam\n";
        exit 0;
        }
if ($header{'x-mailing-list'} ||
    $header{'list-id'} ||
    $header{'precedence'} =~ /junk|bulk|list/i ||
    $header{'to'} =~ /Multiple recipients of/i ||
    $header{'from'} =~ /majordomo/i ||
    $fromline =~ /majordomo/i) {
	# Do nothing if post is from a mailing list
	print STDERR "Cancelling autoreply to message from mailing list\n";
	exit 0;
	}
if ($header{'from'} =~ /postmaster|mailer-daemon/i ||
    $fromline =~ /postmaster|mailer-daemon|<>/ ) {
	# Do nothing if post is a bounce
	print STDERR "Cancelling autoreply to bounce message\n";
	exit 0;
	}

# work out the correct to address
@to = ( &split_addresses($header{'to'}),
	&split_addresses($header{'cc'}),
	&split_addresses($header{'bcc'}) );
$to = $to[0]->[0];
foreach $t (@to) {
	if ($t->[0] =~ /^([^\@\s]+)/ && $1 eq $ARGV[1] ||
	    $t->[0] eq $ARGV[1]) {
		$to = $t->[0];
		}
	}

# build list of default reply headers
$rheader{'From'} = $to;
$rheader{'To'} = $header{'reply-to'} ? $header{'reply-to'}
				     : $header{'from'};
$rheader{'Subject'} = "Autoreply to $header{'subject'}";
$rheader{'X-Webmin-Autoreply'} = 1;
$rheader{'X-Originally-To'} = $header{'to'};
chop($host = `hostname`);
$rheader{'Message-Id'} = "<".time().".".$$."\@".$host.">";
$rheader{'Auto-Submitted'} = 'auto-replied';

# read the autoreply file (or alternate)
if (open(AUTO, "<".$ARGV[0]) ||
    $ARGV[2] && open(AUTO, "<".$ARGV[2])) {
	while(<AUTO>) {
		s/\$SUBJECT/$header{'subject'}/g;
		s/\$FROM/$header{'from'}/g;
		s/\$TO/$to/g;
		s/\$DATE/$header{'date'}/g;
		s/\$BODY/$body/g;
		if (/^(\S+):\s*(.*)/ && !$doneheaders) {
			if ($1 eq "No-Autoreply-Regexp") {
				push(@no_regexp, $2);
				}
			elsif ($1 eq "Must-Autoreply-Regexp") {
				push(@must_regexp, $2);
				}
			elsif ($1 eq "Autoreply-File") {
				push(@files, $2);
				}
			else {
				$rheader{$1} = $2;
				$rheaders .= $_;
				}
			}
		else {
			$rbody .= $_;
			$doneheaders = 1;
			}
		}
	close(AUTO);
	}
else {
	$rbody = "Failed to open autoreply file $ARGV[0] : $!";
	}

if ($header{'x-original-to'} && $rheader{'No-Forward-Reply'}) {
	# Don't autoreply to a forwarded email
	($ot) = &split_addresses($header{'x-original-to'});
	if ($ot->[0] =~ /^([^\@\s]+)/ && $1 ne $ARGV[1] &&
	    $ot->[0] ne $ARGV[1]) {
		print STDERR "Cancelling autoreply to forwarded message\n";
		exit 0;
		}
	}

# Open the replies tracking DBM, if one was set
my $rtfile = $rheader{'Reply-Tracking'};
if ($rtfile) {
	$track_replies = dbmopen(%replies, $rtfile, 0700);
	eval { $replies{"test\@example.com"} = 1; };
	if ($@) {
		# DBM is corrupt! Clear it
		dbmclose(%replies);
		unlink($rtfile.".dir");
		unlink($rtfile.".pag");
		unlink($rtfile.".db");
		$track_replies = dbmopen(%replies, $rtfile, 0700);
		}
	}
if ($track_replies) {
	# See if we have replied to this address before
	$period = $rheader{'Reply-Period'} || 60*60;
	($from) = &split_addresses($header{'from'});
	if ($from) {
		$lasttime = $replies{$from->[0]};
		$now = time();
		if ($now < $lasttime+$period) {
			# Autoreplied already in this period .. just halt
			print STDERR "Already autoreplied at $lasttime which ",
				     "is less than $period ago\n";
			exit 0;
			}
		$replies{$from->[0]} = $now;
		}
	}
delete($rheader{'Reply-Tracking'});
delete($rheader{'Reply-Period'});

# Check if we are within the requested time range
if ($rheader{'Autoreply-Start'} && time() < $rheader{'Autoreply-Start'} ||
    $rheader{'Autoreply-End'} && time() > $rheader{'Autoreply-End'}) {
	# Nope .. so do nothing
	print STDERR "Outside of autoreply window of ",
		     "$rheader{'Autoreply-Start'}-$rheader{'Autoreply-End'}\n";
	exit 0;
	}
delete($rheader{'Autoreply-Start'});
delete($rheader{'Autoreply-End'});

# Check if there is a deny list, and if so don't send a reply
@fromsplit = &split_addresses($header{'from'});
if (@fromsplit) {
	$from = $fromsplit[0]->[0];
	($fromuser, $fromdom) = split(/\@/, $from);
	foreach $n (split(/\s+/, $rheader{'No-Autoreply'})) {
		if ($n =~ /^(\S+)\@(\S+)$/ && lc($from) eq lc($n) ||
		    $n =~ /^\*\@(\S+)$/ && lc($fromdom) eq lc($1) ||
		    $n =~ /^(\S+)\@\*$/ && lc($fromuser) eq lc($1) ||
		    $n =~ /^\*\@\*(\S+)$/ && lc($fromdom) =~ /$1$/i ||
		    $n =~ /^(\S+)\@\*(\S+)$/ && lc($fromuser) eq lc($1) &&
						lc($fromdom) =~ /$2$/i) {
			exit(0);
			}
		}
	delete($rheader{'No-Autoreply'});
	}

# Check if message matches one of the deny regexps, or doesn't match a
# required regexp
foreach $re (@no_regexp) {
	if ($re =~ /\S/ && $headers =~ /$re/i) {
		print STDERR "Skipping due to match on $re\n";
		exit(0);
		}
	}
if (@must_regexp) {
	my $found = 0;
	foreach $re (@must_regexp) {
		if ($headers =~ /$re/i) {
			$found++;
			}
		}
	if (!$found) {
		print STDERR "Skipping due to no match on ",
			     join(" ", @must_regexp),"\n";
		exit(0);
		}
	}

# if spamassassin is installed, feed the email to it
$spam = &has_command("spamassassin");
if ($spam) {
	$temp = "/tmp/autoreply.spam.$$";
	unlink($temp);
	open(SPAM, "| $spam >$temp 2>/dev/null");
	print SPAM $headers;
	print SPAM $body;
	close(SPAM);
	$isspam = undef;
	open(SPAMOUT, "<".$temp);
	while(<SPAMOUT>) {
		if (/^X-Spam-Status:\s+Yes/i) {
			$isspam = 1;
			last;
			}
		last if (!/\S/);
		}
	close(SPAMOUT);
	unlink($temp);
	if ($isspam) {
		print STDERR "Not autoreplying to spam\n";
		exit 0;
		}
	}

# Read attached files
foreach $f (@files) {
	local $/ = undef;
	if (!open(FILE, "<".$f)) {
		print STDERR "Failed to open $f : $!\n";
		exit(1);
		}
	$data = <FILE>;
	close(FILE);
	$f =~ s/^.*\///;
	$type = &guess_mime_type($f)."; name=\"$f\"";
	$disp = "inline; filename=\"$f\"";
	push(@attach, { 'headers' => [ [ 'Content-Type', $type ],
				       [ 'Content-Disposition', $disp ],
				       [ 'Content-Transfer-Encoding', 'base64' ]
				     ],
			'data' => $data });
	}

# Work out the content type and encoding
$type = $rbody =~ /<html[^>]*>|<body[^>]*>/i ? "text/html" : "text/plain";
$cs = $rheader{'Charset'};
delete($rheader{'Charset'});
if ($rbody =~ /[\177-\377]/) {
	# High-ascii
	$enc = "quoted-printable";
	$encrbody = &quoted_encode($rbody);
	$type .= "; charset=".($cs || "UTF-8");
	}
else {
	$enc = undef;
	$encrbody = $rbody;
	$type .= "; charset=$cs" if ($cs);
	}

# run sendmail and feed it the reply
($rfrom) = &split_addresses($rheader{'From'});
if ($rfrom->[0]) {
	open(MAIL, "|$config{'sendmail_path'} -t -f".quotemeta($rfrom->[0]));
	}
else {
	open(MAIL, "|$config{'sendmail_path'} -t -f".quotemeta($to));
	}
foreach $h (keys %rheader) {
	print MAIL "$h: $rheader{$h}\n";
	}

# Create the message body
if (!@attach) {
	# Just text, so no encoding is needed
	if ($enc) {
		print MAIL "Content-Transfer-Encoding: $enc\n";
		}
	if (!$rheader{'Content-Type'}) {
		print MAIL "Content-Type: $type\n";
		}
	print MAIL "\n";
	print MAIL $encrbody;
	}
else {
	# Need to send a multi-part MIME message
	print MAIL "MIME-Version: 1.0\n";
	$bound = "bound".time();
	$ctype = "multipart/mixed";
	print MAIL "Content-Type: $ctype; boundary=\"$bound\"\n";
	print MAIL "\n";
	$bodyattach = { 'headers' => [ [ 'Content-Type', $type ], ],
			'data' => $encrbody };
	if ($enc) {
		push(@{$bodyattach->{'headers'}},
		     [ 'Content-Transfer-Encoding', $enc ]);
		}
	splice(@attach, 0, 0, $bodyattach);

# Send attachments
	print MAIL "This is a multi-part message in MIME format.","\n";
	$lnum++;
	foreach $a (@attach) {
		print MAIL "\n";
		print MAIL "--",$bound,"\n";
		local $enc;
		foreach $h (@{$a->{'headers'}}) {
			print MAIL $h->[0],": ",$h->[1],"\n";
			$enc = $h->[1]
				if (lc($h->[0]) eq 'content-transfer-encoding');
			$lnum++;
			}
		print MAIL "\n";
		$lnum++;
		if (lc($enc) eq 'base64') {
			local $enc = &encode_base64($a->{'data'});
			$enc =~ s/\r//g;
			print MAIL $enc;
			}
		else {
			$a->{'data'} =~ s/\r//g;
			$a->{'data'} =~ s/\n\.\n/\n\. \n/g;
			print MAIL $a->{'data'};
			if ($a->{'data'} !~ /\n$/) {
				print MAIL "\n";
				}
			}
		}
	print MAIL "\n";
	print MAIL "--",$bound,"--","\n";
	print MAIL "\n";
	}
close(MAIL);

# split_addresses(string)
# Splits a comma-separated list of addresses into [ email, real-name, original ]
# triplets
sub split_addresses
{
local (@rv, $str = $_[0]);
while(1) {
	if ($str =~ /^[\s,]*(([^<>"\s]+)\s+$([^\($]+)\))(.*)$/) {
		# An address like  foo@bar.com (Fooey Bar)
		push(@rv, [ $2, $3, $1 ]);
		$str = $4;
		}
	elsif ($str =~ /^[\s,]*("([^"]+)"\s*<([^\s<>,]+)>)(.*)$/ ||
	       $str =~ /^[\s,]*(([^<>\@]+)\s+<([^\s<>,]+)>)(.*)$/ ||
	       $str =~ /^[\s,]*(([^<>\@]+)<([^\s<>,]+)>)(.*)$/ ||
	       $str =~ /^[\s,]*(([^<>\[\]]+)\s+\[mailto:([^\s\[\]]+)\])(.*)$/||
	       $str =~ /^[\s,]*(()<([^<>,]+)>)(.*)/ ||
	       $str =~ /^[\s,]*(()([^\s<>,]+))(.*)/) {
		# Addresses like  "Fooey Bar" <foo@bar.com>
		#                 Fooey Bar <foo@bar.com>
		#                 Fooey Bar<foo@bar.com>
		#		  Fooey Bar [mailto:foo@bar.com]
		#		  <foo@bar.com>
		#		  <group name>
		#		  foo@bar.com
		push(@rv, [ $3, $2 eq "," ? "" : $2, $1 ]);
		$str = $4;
		}
	else {
		last;
		}
	}
return @rv;
}

# encode_base64(string)
# Encodes a string into base64 format
sub encode_base64
{
    local $res;
    pos($_[0]) = 0;                          # ensure start at the beginning
    while ($_[0] =~ /(.{1,57})/gs) {
        $res .= substr(pack('u57', $1), 1)."\n";
        chop($res);
    }
    $res =~ tr|\` -_|AA-Za-z0-9+/|;
    local $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if ($padding);
    return $res;
}

# guess_mime_type(filename)
sub guess_mime_type
{
local ($file) = @_;
return $file =~ /\.gif/i ? "image/gif" :
       $file =~ /\.(jpeg|jpg)/i ? "image/jpeg" :
       $file =~ /\.txt/i ? "text/plain" :
       $file =~ /\.(htm|html)/i ? "text/html" :
       $file =~ /\.doc/i ? "application/msword" :
       $file =~ /\.xls/i ? "application/vnd.ms-excel" :
       $file =~ /\.ppt/i ? "application/vnd.ms-powerpoint" :
       $file =~ /\.(mpg|mpeg)/i ? "video/mpeg" :
       $file =~ /\.avi/i ? "video/x-msvideo" :
       $file =~ /\.(mp2|mp3)/i ? "audio/mpeg" :
       $file =~ /\.wav/i ? "audio/x-wav" :
			   "application/octet-stream";
}

sub read_config_file
{
local %config;
if (open(CONF, "<".$_[0])) {
	while(<CONF>) {
		if (/^(\S+)=(.*)/) {
			$config{$1} = $2;
			}
		}
	close(CONF);
	}
return %config;
}

# quoted_encode(text)
# Encodes text to quoted-printable format
sub quoted_encode
{
local $t = $_[0];
$t =~ s/([=\177-\377])/sprintf("=%2.2X",ord($1))/ge;
return $t;
}

sub has_command
{
local ($cmd) = @_;
if ($cmd =~ /^\//) {
	return -x $cmd ? $cmd : undef;
	}
else {
	foreach my $d (split(":", $ENV{'PATH'}), "/usr/bin", "/usr/local/bin") {
		return "$d/$cmd" if (-x "$d/$cmd");
		}
	return undef;
	}
}

${this.title}

Code Editor : autoreply.pl