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: 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 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 () { 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(<