Article 7765 of comp.lang.perl:
Xref: feenix.metronet.com alt.security:3701 comp.security.misc:3979 comp.unix.admin:7010 comp.mail.sendmail:3055 comp.lang.perl:7765 alt.sources:2241
Newsgroups: alt.security,comp.security.misc,comp.unix.admin,comp.mail.sendmail,comp.lang.perl,alt.sources
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!paladin.american.edu!darwin.sura.net!sgiblab!a2i!dhesi
From: dhesi@rahul.net (Rahul Dhesi)
Subject: perl prog mailer for sendmail
Message-ID: <CG8sCB.355@rahul.net>
Followup-To: alt.security,comp.security.misc,comp.unix.admin,comp.mail.sendmail,comp.lang.perl,alt.sources.d
Keywords: CA-93:16.sendmail.vulnerabilty
Sender: news@rahul.net (Usenet News)
Nntp-Posting-Host: bolero
Organization: a2i network
References: <1993Nov4.222156.12805@sei.cmu.edu>
Date: Tue, 9 Nov 1993 20:45:46 GMT
Lines: 227

Checksum: 3702811482 (verify with 'brik')
Submitter: Rahul Dhesi <dhesi@rahul.net>
Archive-name: perl-source/dhesi/a2iprog

#! /local/bin/perl
# (C) Copyright 1993 Rahul Dhesi, All rights reserved.
# Permission for copying and creation of derivative works is granted,
# provided this copyright notice is preserved, to anybody who
# does not discriminate against the copyright owner.

# $Source: /etc/ida/RCS/a2iprog,v $
# $Id: a2iprog,v 1.12 1993/11/09 12:43:02 dhesi Exp $
#
# A sendmail restricted prog mailer in perl.
#
# This perl script allows some degree of security in invoking programs
# from sendmail's prog mailer.  The reason I wrote it was because smrsh
# requires the argument supplied to it to be the name of a program.  This
# is more restrictive than /bin/sh, which simply wants any command line.
#
# The sendmail problem is that the prog mailer can be invoked on commands
# that are neither in a user's .forward file nor in the /etc/aliases
# file.  The attached program will allow any command to be executed if
# any line in the user's .forward file matches it.  This allows any valid
# shell command to be executed.  If the command is not found in the
# .forward file, it may still be executed if it matches an internal list
# of allowed commands.
#
#
# CAVEATS:
# - Before attempting to match command name with lines in .forward file,
#   double quotes, whitespace, and semicolons in both
#   are stripped.  Then the match is considered to be successful if
#   the command being executed is a substring of any line in the
#   .forward file.  A very clever cracker could perhaps
#   find a string that would pass this test and still allow a break-in.
#   The reason for stripping quotes and whitespace is to allow a simple
#   string comparison do be done without actually parsing lines in the
#   .forward file.  The substring match is done so that .forward lines
#   with multiple comma-separated entries will continue to work.
#   Semicolon is stripped because I was seeing a2iprog receive commands
#   in which an embedded semicolon had been lost (perhaps because sendmail
#   strips it out).
# - Although this script appears to work, it has been only briefly tested.
#   Bugs might be lurking!  Use at your own risk.

# Commands allowed even if not in .forward file.  These are perl patterns
# (but note that '/' is a literal here).
@CMDLIST = (
   '/usr/lib/sendmail.*',
   '/local/lib/market/get\.market',
);

$RCSHEADER = 
   '$Source: /etc/ida/RCS/a2iprog,v $' .
   "\n" .
   '$Id: a2iprog,v 1.12 1993/11/09 12:43:02 dhesi Exp $';

$myname = 'a2iprog';
$usage = "usage: $myname [-c] [-u user] [-vtx] arg ... (or -h for help)";

# standard error message
$cannot = "Cannot mail directly to programs";

# ignore initial -c without invoking getopts
($ARGV[0] eq '-c') && shift;

if ($ARGV[0] =~ "^-.+" ) {
   require "getopts.pl";
   &Getopts("vtxhcu:");
}

# $opt_c will be ignored
$debug = $opt_x;
$trace = $opt_t;
$verbose = $debug || $trace || $opt_v;

# test
## $verbose = 1;

if ($opt_h) {
   &givehelp();
   exit(0);
}

(@ARGV != 1) && &usage_error;
$cmd = $ARGV[0];

# re-initialize environment
$PATH = $ENV{'PATH'}; 
$HOME = $ENV{'HOME'};
undef %ENV;
$ENV{'PATH'} = $PATH; 
$ENV{'HOME'} = $HOME;
$ENV{'IFS'} = ' ';

# If -u given, pretend to have that username or uid, else use our
# effective uid.  THIS IS FOR TESTING PATTERN MATCHING.  IT DOES NOT
# ACTUALLY CHANGE UID.
if ($opt_u) {
   if ($opt_u =~ /^\d+$/) {
      $uid = $opt_u;
   } else {
      # convert name to numeric uid
      $uid = (getpwnam($opt_u))[2];
   }
} else {
   $uid = $>;
}

# get our name and home directory
(
   ($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = 
      (getpwuid($uid))
) || &err("Who are you?");

if ($verbose) {
   print "user: $user\n";
   print "dir: $dir\n";
}
print "command: [$cmd]\n";

chdir($dir) || &err("Can't cd to $dir: $!");

# Now check to see if command is allowed

if (&ok_in_forward($cmd) || &ok_in_list($cmd)) {
   $verbose && print "exec: /bin/sh -c $cmd\n";
   $trace && exit(0);
   # disallow real or effective uid 0
   (($< == 0) || ($> == 0)) && &err("What are you?");
   exec '/bin/sh', '-c', $cmd;
   &err("exec failed: $!");
}
&err($cannot);

sub ok_in_forward {
   local($cmd) = @_;
   local($item);
   if (!open(F, ".forward")) {
      $verbose && print "cannot open .forward\n";
      return 0;
   }
   $verbose && print ".forward open\n";

   # squeeze out blanks, double quotes, semicolons
   $cmd =~ s/[ ";]//g;
   $verbose && print "checking command [$cmd]\n";
   while (<F>) {
      chop;
      $fwline = $_;
      $verbose && print ".forward line: $fwline\n";
      # squeeze out blanks, double quotes, semicolons
      $fwline =~ s/[ ";]//g;
      ($cmdpat = $cmd)  =~ s/(\W)/\\$1/g;	# convert command to pattern
      if ($fwline =~ /$cmdpat/) { # if cmd is embedded inside forw line
	 $verbose && print "matched item [$cmd]\n";
	 return 1;
      } elsif ($verbose) {
	 print "mismatch [$fwline] [$cmd]\n";
	 print "pattern was: [$cmdpat]\n";
      }
   }
   $verbose && print ".forward check failed\n";
   0;
}

# check against internal list
sub ok_in_list {
   local($cmd) = @_;
   local($item);
   for $item (@CMDLIST) {
      if ($cmd =~ /^$item$/) {
	 if ($verbose) {
	    print "cmd [$cmd] item [$item]\n";
	    "cmdlist check ok\n";
	 }
	 return 1;
      }
   }
   0;
}

sub usage_error {
   local($msg) = @_;
   if ($msg) {
      die "$msg\n";
   } else {
      die "$usage\n";
   }
}

sub givehelp {
   ## require 'local/page.pl';
   ## &page(<<EOF);
   print <<EOF;
$usage

This is a restricted prog mailer for use from sendmail.  It allows
execution of a shell command only if one of the following two
conditions holds.

1.  The effective user's .forward file contains that command.
2.  The command matches a pattern in a hard-coded list inside $myname.

Refer to source code for more details about string comparisons.

Based on ideas in smrsh.

   -u uid	Pretend to be this username or uid (for testing pattern
		matching -- does not actually change to that uid).
   -c		Ignored, for compatibility with sh and smrsh.
   -v		Be verbose.
   -t		Trace only -- show what would be done but don't do it.
   -x		Enable debugging -- for program maintainers.

$RCSHEADER
EOF
}

# Error exit -- always exit with error code.
# Caller must include trailing newline in message.
sub err {
   @_ && print "$_[0]\n";
   exit(1);
}
# END OF SCRIPT