1;# $Id$ 2;# 3;# Copyright (c) 1990-2006, Raphael Manfredi 4;# 5;# You may redistribute only under the terms of the Artistic License, 6;# as specified in the README file that comes with the distribution. 7;# You may reuse parts of this distribution only within the terms of 8;# that same Artistic License; a copy of which may be found at the root 9;# of the source tree for mailagent 3.0. 10;# 11;# $Log: cmdserv.pl,v $ 12;# Revision 3.0.1.7 1999/07/12 13:50:49 ram 13;# patch66: factorized servshell handling in function 14;# 15;# Revision 3.0.1.6 1998/07/28 17:02:15 ram 16;# patch62: shell used is now customized by the "servshell" variable 17;# 18;# Revision 3.0.1.5 1998/03/31 15:20:35 ram 19;# patch59: changed "set" to dump variables when not given any argument 20;# 21;# Revision 3.0.1.4 1997/02/20 11:43:12 ram 22;# patch55: made 'perl -cw' clean 23;# 24;# Revision 3.0.1.3 1996/12/24 14:50:16 ram 25;# patch45: all power-sensitive actions can now be logged separately 26;# patch45: launch sendmail only when session is done to avoid timeouts 27;# patch45: perform security checks on all server commands 28;# 29;# Revision 3.0.1.2 1995/08/07 16:18:26 ram 30;# patch37: fixed symbol table lookups for perl5 support 31;# 32;# Revision 3.0.1.1 1994/10/04 17:49:52 ram 33;# patch17: now uses the email config parameter to send messages to user 34;# patch17: ensures envelope is not an hostile address before processing 35;# patch17: the process routine now returns a failure/success condition 36;# 37;# Revision 3.0 1993/11/29 13:48:37 ram 38;# Baseline for mailagent 3.0 netwide release. 39;# 40;# 41;# The command server is configured by a 'command' file, which lists the 42;# available commands, their type and their locations. The command file has 43;# the following format: 44;# 45;# <cmd_name> <type> <hide> <collect> <path> <extra> 46;# 47;# - cmd_name: the name of the command recognized by the server. 48;# - type: the type of command: shell, perl, var, flag, help or end. 49;# - hide: argument to hide in transcript (password usually). 50;# - collect: whether the command collects data following in mail message. Set 51;# to '-' means no, otherwise 'yes' means collecting is needed. 52;# - path: the location of the executable for shell commands (may be left out 53;# by specifying '-', in which case the command will be searched for in the 54;# path), the file where the command is implemented for perl commands, and 55;# the directory where help files are located for help, one file per command. 56;# - extra: either some options for shell commands or the name of the function 57;# within the perl file. 58;# 59;# Each command has an environment set up (part of the process environment for 60;# shell commands, part of perl cmdenv package for other commands processed 61;# by perl). This basic environment consists of: 62;# - jobnum: the job number of the current mailagent. 63;# - cmd: the command line as written in the message. 64;# - name: the command name. 65;# - log: what was logged in transcript (some args possibly concealed) 66;# - pack: packing mode for file sending. 67;# - path: destination for the command (where to send file / notification). 68;# - auth: set to true if valid envelope found (can "authenticate" sender). 69;# - uid: address of the sender of the message (where to send transcript). 70;# - user: user's e-mail, equivalent to UNIX euid here (initially uid). 71;# - trace: true when command trace wanted in transcript (shell commands). 72;# - powers: a colon separated list of privileges the user has. 73;# - errors: number of errors so far 74;# - requests: number of requests processed so far 75;# - eof: the end of file for collection mode 76;# - collect: true when collecting a file 77;# - disabled: a list of commands disabled (comma separated) 78;# - trusted: true when server in trust mode (where powers may be gainned) 79;# - debug: true in debug mode 80;# - approve: approve password for 'approve' commands, empty if no approve 81;# 82;# All convenience variables normally defined for the PERL command are also 83;# made part of the command environment. 84;# 85;# For perl commands, collected data is available in the @buffer environment. 86;# Shell commands can see those collected data by reading stdin. 87;# 88;# TODO: 89;# Commands may be batched for later processing, in the batch queue. Each job 90;# is recorded in a 'cm' file, the environment of the command itself is written 91;# at the top, ending with a blank line and followed by the actual command to 92;# be exectuted (i.e. the internal representation of 'cmd'). 93;# 94# 95# Command server 96# 97 98package cmdserv; 99 100$loaded = 0; # Set to true when loading done 101 102# Initialize builtin server commands 103sub init { 104 %Builtin = ( # Builtins and their implemetation routine 105 'addauth', 'run_addauth', # Append to power clearance file 106 'approve', 'run_approve', # Record password for forthcoming command 107 'delpower', 'run_delpower', # Delete power from system 108 'getauth', 'run_getauth', # Get power clearance file 109 'newpower', 'run_newpower', # Add a new power to the system 110 'passwd', 'run_passwd', # Change power password, alternate syntax 111 'password', 'run_password', # Set new password for power 112 'power', 'run_power', # Ask for new power 113 'powers', 'run_powers', # A list of powers, along with clearances 114 'release', 'run_release', # Abandon power 115 'remauth', 'run_remauth', # Remove people from clearance file 116 'set', 'run_set', # Set internal variables 117 'setauth', 'run_setauth', # Set power clearance file 118 'user', 'run_user', # Commands on behalf of new user 119 ); 120 %Conceal = ( # Words to be hidden in transcript 121 'power', '2', # Protect power password 122 'password', '2', # Second argument is password 123 'passwd', '2,3', # Both old and new passwords are concealed 124 'newpower', '2', # Power password 125 'delpower', '2,3', # Power password and security 126 'getauth', '2', # Power password if no system clearance 127 'setauth', '2', # Power password 128 'addauth', '2', # Power password 129 'remauth', '2', # Power passowrd 130 'approve', '1', # Approve passoword 131 ); 132 %Collect = ( # Commands collecting more data from mail 133 'newpower', 1, # Takes list of allowed addresses 134 'setauth', 1, # Takes new list of allowed addresses 135 'addauth', 1, # Allowed addresses to be added 136 'remauth', 1, # List of addresses to be deleted 137 ); 138 %Set = ( # Internal variables which may be set 139 'debug', 'flag', # Debugging mode 140 'eof', 'var', # End of file marker (default is EOF) 141 'pack', 'var', # Packing mode for file sending 142 'path', 'var', # Destination address for file sending 143 'trace', 'flag', # The trace flag 144 ); 145} 146 147# Load command file into memory, setting %Command, %Type, %Path and %Extra 148# arrays, all indexed by a command name. 149sub load { 150 $loaded = 1; # Do not come here more than once 151 &init; # Initialize builtins 152 return unless -s $cf'comserver; # Empty or non-existent file 153 return unless &'file_secure($cf'comserver, 'server command'); 154 unless (open(COMMAND, $cf'comserver)) { 155 &'add_log("ERROR cannot open $cf'comserver: $!") if $'loglvl; 156 &'add_log("WARNING server commands not loaded") if $'loglvl > 5; 157 return; 158 } 159 160 local($_); 161 local($cmd, $type, $hide, $collect, $path, @extra); 162 local(%known_type) = ( 163 'perl', 1, # Perl script loaded dynamically 164 'shell', 1, # Program to run via fork/exec 165 'help', 1, # Help, send back files from dir 166 'end', 1, # End processing of requests 167 'flag', 1, # A variable flag 168 'var', 1, # An ascii variable 169 ); 170 local(%set_type) = ( 171 'flag', 1, # Denotes a flag variable 172 'var', 1, # Denotes an ascii variable 173 ); 174 175 while (<COMMAND>) { 176 next if /^\s*#/; # Skip comments 177 next if /^\s*$/; # Skip blank lines 178 ($cmd, $type, $hide, $collect, $path, @extra) = split(' '); 179 $path =~ s/~/$cf'home/; # Perform ~ substitution 180 181 # Perl commands whose function name is not defined will bear the same 182 # name as the command itself. If no path was specified, use the value 183 # of the servdir configuration parameter from ~/.mailagent and assume 184 # each command is stored in a cmd or cmd.pl file. Same for shell 185 # commands, expected in a cmd or cmd.sh file. However, if the shell 186 # command is not found there, it will be located at run-time using the 187 # PATH variable. 188 @extra = ($cmd) if $type eq 'perl' && @extra == 0; 189 if ($type eq 'perl' || $type eq 'shell') { 190 if ($path eq '-') { 191 $path = "$cf'servdir/$cmd"; 192 $path = "$cf'servdir/$cmd.pl" if $type eq 'perl' && !-e $path; 193 $path = "$cf'servdir/$cmd.sh" if $type eq 'shell' && !-e $path; 194 $path = '-' if $type eq 'shell' && !-e $path; 195 } elsif ($path !~ m|^/|) { 196 $path = "$cf'servdir/$path"; 197 } 198 } 199 200 # If path is specified, make sure it is valid 201 if ($path ne '-' && !(-e $path && (-r _ || -x _))) { 202 local($home) = $cf'home; 203 $home =~ s/(\W)/\\$1/g; # Escape possible metacharacters (+) 204 $path =~ s/^$home/~/; 205 &'add_log("ERROR command '$cmd' bound to invalid path $path") 206 if $'loglvl > 1; 207 next; # Ignore invalid command 208 } 209 210 # Verify command type 211 unless ($known_type{$type}) { 212 &'add_log("ERROR command '$cmd' has unknown type $type") 213 if $'loglvl > 1; 214 next; # Skip to next command 215 } 216 217 # If command is a variable, record it in the %Set array. Since all 218 # variables are proceseed separately from commands, it is perfectly 219 # legal to have both a command and a variable bearing the same name. 220 if ($set_type{$type}) { 221 $Set{$cmd} = $type; # Record variable as being of given type 222 next; 223 } 224 225 # Load command into internal data structures 226 $Command{$cmd}++; # Record known command 227 $Type{$cmd} = $type; 228 $Path{$cmd} = $path; 229 $Extra{$cmd} = join(' ', @extra); 230 $Conceal{$cmd} = $hide if $hide ne '-'; 231 $Collect{$cmd}++ if $collect =~ /^y/i; 232 } 233 close COMMAND; 234} 235 236# Process server commands held in the body, either by batching them or by 237# executing them right away. A transcript is sent to the sender. 238# Requires a previous call to 'setuid'. 239sub process { 240 local(*body) = @_; # Mail body 241 local($_); # Current line processed 242 local($metoo); # Send blind carbon copy to me too? 243 244 &load unless $loaded; # Load commands unless already done 245 $cmdenv'jobnum = $'jobnum; # Propagate job number 246 $metoo = $cf'email if $cf'scriptcc =~ /^on/i; 247 248 # Make sure sender address is not hostile 249 unless (&addr'valid($cmdenv'uid)) { 250 &add_log("ERROR $cmdenv'uid is an hostile sender address") 251 if $'loglvl > 1; 252 return 1; # Failed, will discard whole mail message then 253 } 254 255 # Set up a mailer pipe to send the transcript back to the sender 256 # 257 # We used to do a simple: 258 # open(MAILER, "|$cf'sendmail $cf'mailopt $cmdenv'uid $metoo") 259 # here but this had a nasty side effect with smart mailers: a 260 # lengthy command could cause a timeout, breaking the pipe and leading 261 # to a failure. 262 # 263 # Intead, we just create a temporary file somewhere, and immediately 264 # unlink it. Keeping the fd preciously lets us manipulate this temporary 265 # file with the insurance that it will not leave any trace should we 266 # fail abruptly. 267 268 unless (open(MAILER, "+>$cf'tmpdir/serv.mail$$")) { 269 &'add_log("ERROR cannot create temporary mail transcript: $!") 270 if $'loglvl > 1; 271 } 272 273 # We may fork and have to close one end of the MAILER pipe, so make sure 274 # no unflushed data ever remain... 275 select((select(MAILER), $| = 1)[0]); 276 277 # Build up initial header. Be sure to add a junk precedence, since we do 278 # not want to get any bounces. 279 # For some reason, perl 4.0 PL36 fails with the here document construct 280 # when using dataloading. 281 print MAILER 282"To: $cmdenv'uid 283Subject: Mailagent session transcript 284Precedence: junk 285$main'MAILER 286 287 ---- Mailagent session transcript for $cmdenv'uid ---- 288"; 289 290 # Start message processing. Stop as soon as an ending command is reached, 291 # or when more than 'maxerrors' errors have been detected. Also stop 292 # processing when a signature is reached (introduced by '--'). 293 294 foreach (@body) { 295 if ($cmdenv'collect) { # Collecting data for command 296 if ($_ eq $cmdenv'eof) { # Reached end of "file" 297 $cmdenv'collect = 0; # Stop collection 298 &execute; # Execute command 299 undef @cmdenv'buffer; # Free memory 300 } else { 301 push(@cmdenv'buffer, $_); 302 } 303 next; 304 } 305 if ($cmdenv'errors > $cf'maxerrors && !&root) { 306 &finish('too many errors'); 307 last; 308 } 309 if ($cmdenv'requests > $cf'maxcmds && !&root) { 310 &finish('too many requests'); 311 last; 312 } 313 next if /^\s*$/; # Skip blank lines 314 print MAILER "\n"; # Separate each command 315 s/^\s*//; # Strip leading spaces 316 &cmdenv'set_cmd($_); # Set command environment 317 $cmdenv'approve = ''; # Clear approve password 318 &user_prompt; # Copy line to transcript 319 if (/^--\s*$/) { # Signature reached 320 &finish('.signature'); 321 last; 322 } 323 if ($Disabled{$cmdenv'name}) { # Skip disabled commands 324 $cmdenv'errors++; 325 print MAILER "Disabled command.\n"; 326 print MAILER "FAILED.\n"; 327 &'add_log("DISABLED $cmdenv'log") if $'loglvl > 1; 328 next; 329 } 330 unless (defined $Builtin{$cmdenv'name}) { 331 unless (defined $Command{$cmdenv'name}) { 332 $cmdenv'errors++; 333 print MAILER "Unknown command.\n"; 334 print MAILER "FAILED.\n"; 335 &'add_log("UNKNOWN $cmdenv'log") if $'loglvl > 1; 336 next; 337 } 338 if ($Type{$cmdenv'name} eq 'end') { # Ending request? 339 &finish("user's request"); # Yes, end processing then 340 last; 341 } 342 } 343 if (defined $Collect{$cmdenv'name}) { 344 $cmdenv'collect = 1; # Start collect mode 345 next; # Grab things in @cmdenv'buffer 346 } 347 &execute; # Execute command, report in transcript 348 } 349 350 # If we are still in collecting mode, then the EOF marker was not found 351 if ($cmdenv'collect) { 352 &'add_log("ERROR did not reach eof mark '$cmdenv'eof'") 353 if $'loglvl > 1; 354 &'add_log("FAILED $cmdenv'log") if $'loglvl > 1; 355 print MAILER "Could not find eof marker '$cmdenv'eof'.\n"; 356 print MAILER "FAILED.\n"; 357 } 358 359 print MAILER <<EOM; 360 361 ---- End of mailagent session transcript ---- 362EOM 363 364 # We used to simply close MAILER at this point, but it is now a fd on 365 # a temporary file. We're going to rewind in and copy it onto the SENDMAIL 366 # real mailer descriptor. 367 368 unless (open(SENDMAIL, "|$cf'sendmail $cf'mailopt $cmdenv'uid $metoo")) { 369 &'add_log("ERROR cannot start $cf'sendmail to mail transcript: $!") 370 if $'loglvl > 1; 371 unless (open(SENDMAIL, ">> $cf'emergdir/serv-msg.$$")) { 372 &'add_log("ERROR can't even dump into $cf'emergdir/serv-msg.$$: $!") 373 if $'loglvl > 1; 374 # Last chance, print on STDOUT 375 open(SENDMAIL, '>&STDOUT'); 376 &'add_log("NOTICE dumping server transcript on stdout") 377 if $'loglvl > 6; 378 print STDOUT "*** dumping server transcript: ***\n"; 379 } 380 } 381 382 unless (seek(MAILER, 0, 0)) { 383 &'add_log("ERROR cannot seek back to start of transcript: $!") 384 if $'loglvl > 1; 385 } 386 387 local($l); 388 while (defined ($l = <MAILER>)) { 389 print SENDMAIL $l; 390 } 391 close MAILER; # Bye bye temporary file 392 393 unless (close SENDMAIL) { 394 &'add_log("ERROR cannot mail transcript to $cmdenv'uid") 395 if $'loglvl > 1; 396 } 397 0; # Success 398} 399 400# 401# Command execution 402# 403 404# Execute command recorded in the cmdenv environment. For each type of command, 405# the routine 'exec_type' is called and returns 0 if ok. Builtins are dealt 406# separately by calling the corresponding perl function. 407sub execute { 408 $cmdenv'requests++; # One more request 409 local($log) = $cmdenv'log; # Save log, since it could be modified 410 local($failed) = &dispatch; # Dispatch command 411 if ($failed) { 412 &'add_log("FAILED $log") if $'loglvl > 1; 413 $cmdenv'errors++; 414 print MAILER "FAILED.\n"; 415 } else { 416 &'add_log("OK $log") if $'loglvl > 2; 417 print MAILER "OK.\n"; 418 } 419} 420 421# Dispatch command held in $cmdenv'name and return failure status (0 means ok). 422sub dispatch { 423 local($failed) = 0; 424 &'add_log("XEQ ($cmdenv'name) as $cmdenv'user") if $'loglvl > 10; 425 if (defined $Builtin{$cmdenv'name}) { # Deal separately with builtins 426 eval "\$failed = &$Builtin{$cmdenv'name}"; # Call builtin function 427 if (chop($@)) { 428 print MAILER "Perl failure: $@\n"; 429 $@ .= "\n"; # Restore final char for &'eval_error call 430 &'eval_error; # Log error 431 $@ = ''; # Clear evel error condition 432 $failed++; # Make sure failure is recorded 433 } 434 } else { 435 # Command may be unknwon if called from 'user <email> command' or 436 # from an 'approve <password> comamnd' type of invocation. 437 if (defined $Type{$cmdenv'name}) { 438 eval "\$failed = &exec_$Type{$cmdenv'name}"; 439 } else { 440 print MAILER "Unknown command.\n"; 441 $cmdenv'errors++; 442 $failed++; 443 } 444 } 445 $failed; # Report failure status 446} 447 448# Shell command 449sub exec_shell { 450 # Check for unsecure characters in shell command 451 if ($cmdenv'cmd =~ /([=\$^&*([{}`\\|;><?])/ && !&root) { 452 $cmdenv'errors++; 453 print MAILER "Unsecure character '$1' in command line.\n"; 454 return 1; # Failed 455 } 456 457 # Initialize input script (if command operates in 'collect' mode) 458 local($error) = 0; # Error flag 459 local($input) = ''; # Input file, when collecting 460 if (defined $Collect{$cmdenv'name}) { 461 $input = "$cf'tmpdir/input.cmd$$"; 462 unless (open(INPUT, ">$input")) { 463 &'add_log("ERROR cannot create $input: $!") if $'loglvl; 464 $error++; 465 } else { 466 foreach $collected (@cmdenv'buffer) { 467 (print INPUT $collected, "\n") || $error++; 468 &'add_log("SYSERR write: $!") if $error && $'loglvl; 469 last if $error; 470 } 471 close(INPUT) || $error++; 472 &'add_log("SYSERR close: $!") if $error == 1 && $'loglvl; 473 } 474 if ($error) { 475 print MAILER "Cannot create input file ($!).\n"; 476 &'add_log("ERROR cannot initialize input file") if $'loglvl; 477 unlink $input; 478 return 1; # Failed 479 } 480 } 481 482 # Ensure the command we're about to execute is secure 483 local(@argv) = split(' ', $cmdenv'cmd); 484 $argv[0] = $Path{$cmdenv'name} if defined $Path{$cmdenv'name}; 485 local($cmd) = &'locate_program($argv[0]); 486 unless ($cmd =~ m|/|) { 487 &'add_log("ERROR cannot locate $cmd") if $'loglvl; 488 unlink $input if $input; 489 print MAILER "Unable to locate command.\n"; 490 return 1; # Failed 491 } 492 unless (&'exec_secure($cmd, 'server command')) { 493 &'add_log("ERROR unsecure command $cmd") if $'loglvl; 494 unlink $input if $input; 495 print MAILER "Unable to locate command.\n"; # Don't tell them the truth! 496 return 1; # Failed 497 } 498 499 # Create shell command file, whose purpose is to set up the environment 500 # properly and do the appropriate file descriptors manipulations, which 501 # is easier to do at the shell level, and cannot fully be done in perl 4.0 502 # (see dup2 hack below). 503 $cmdfile = "$cf'tmpdir/mess.cmd$$"; 504 unless (open(CMD, ">$cmdfile")) { 505 &'add_log("ERROR cannot create $cmdfile: $!") if $'loglvl; 506 print MAILER "Cannot create file comamnd file ($!).\n"; 507 unlink $input if $input; 508 return 1; # Failed 509 } 510 511 # Initialize command environment 512 local($key, $val); # Key/value from perl's symbol table 513 local($value); 514 # Loop over perl's symbol table for the cmdenv package 515 eval "*_cmdenv = *::cmdenv::" if $] > 5; # Perl 5 support 516 while (($key, $val) = each %_cmdenv) { 517 local(*entry) = $val; # Get definitaions of current slot 518 &'add_log("considering variable $key") if $'loglvl > 15; 519 next unless defined $entry; # No variable slot 520 next if $key !~ /^[a-z]\w+$/i; # Skip invalid names for shell 521 ($value = $entry) =~ s/'/'"'"'/g; # Keep simple quotes 522 (print CMD "$key='$value' export $key\n") || $error++; 523 &'add_log("env set $key='$value'") if $'loglvl > 15; 524 } 525 # Now add command invocation and input redirection. Standard input will be 526 # the collect buffer, if any, and file descriptor #3 is a path to the 527 # session transcript. 528 local($redirect); 529 local($extra) = $Extra{$cmdenv'name}; 530 $redirect = "<$input" if $input; 531 (print CMD "cd $cf'home\n") || $error++; # Make sure we start from home 532 (print CMD "exec 3>&2 2>&1\n") || $error++; # See dup2 hack below 533 (print CMD "$argv[0] $extra @argv[1..$#argv] $redirect\n") || $error++; 534 close(CMD) || $error++; 535 close CMD; 536 if ($error) { 537 &'add_log("ERROR cannot initialize $cmdfile: $!") if $'loglvl; 538 unlink $cmdfile; 539 unlink $input if $input; 540 print MAILER "Cannot initialize command file ($!).\n"; 541 return 1; # Failed 542 } 543 544 &include($cmdfile, 'command', '<<< ') if $cmdenv'debug; 545 546 # Set up trace file 547 $trace = "$cf'tmpdir/trace.cmd$$"; 548 unless (open(TRACE, ">$trace")) { 549 &'add_log("ERROR cannot create $trace: $!") if $'loglvl; 550 unlink $cmdfile; 551 unlink $input if $input; 552 print MAILER "Cannot create trace file ($!).\n"; 553 return 1; # Failed 554 } 555 556 # Now fork a child which will redirect stdout and stderr onto the trace 557 # file and exec the command file. 558 559 local($pid) = fork; # We fork here 560 unless (defined $pid) { # Apparently, we could not fork... 561 &'add_log("SYSERR fork: $!") if $'loglvl; 562 close TRACE; 563 unlink $cmdfile, $trace; 564 unlink $input if $input; 565 print MAILER "Cannot fork ($!).\n"; 566 return 1; # Failed 567 } 568 569 # Child process runs the command 570 if ($pid == 0) { # Child process 571 # Perform a dup2(MAILER, 3) to allow file descriptor #3 to be a way 572 # for the shell script to reach the session transcript. Since perl 573 # insists on closing all file descriptors >2 ($^F) during the exec, we 574 # remap the current STDERR to MAILER temporarily. That way, it will 575 # be transmitted to the child, which is a shell script doing an 576 # 'exec 3>&2 2>&1', meaning the file #3 is the original MAILER and 577 # stdout and stderr for the script go to the same trace file, as 578 # intiallly attached to stdout. 579 # 580 open(STDOUT, '>&TRACE'); # Redirect stdout to the trace file 581 open(STDERR, '>&MAILER'); # Temporarily mapped to the MAILER file 582 close(STDIN); # Make sure there is no input 583 584 # For HPUX-10.x, grrr... have to use /bin/ksh otherwise that silly 585 # posix shell closes all the file descriptors greater than 2, defeating 586 # all our cute setting here... 587 588 local($shell) = &servshell; 589 590 # Using a sub-block ensures exec() is followed by nothing 591 # and makes mailagent "perl -cw" clean, whatever that means ;-) 592 { exec "$shell $cmdfile" } # Don't let perl use sh -c 593 594 &'add_log("SYSERR exec: $!") if $'loglvl; 595 &'add_log("ERROR cannot exec $shell $cmdfile") if $'loglvl; 596 print MAILER "Cannot exec command file ($!).\n"; 597 exit(9); 598 } 599 600 close TRACE; # Only child uses it 601 wait; # Wait for child 602 unlink $cmdfile; # Has been used and abused... 603 unlink $input if $input; 604 605 if ($?) { # Child exited with non-zero status 606 local($status) = $? >> 8; 607 &'add_log("ERROR child exited with status $status") if $'loglvl > 1; 608 print MAILER "Command returned a non-zero status ($status).\n"; 609 $error = 1; 610 } 611 &include($trace, 'trace', '<<< ') if $error || $cmdenv'trace; 612 unlink $trace; 613 $error; # Failure status 614} 615 616# Perl command 617sub exec_perl { 618 local($name) = $cmdenv'name; # Command name 619 local($fn) = $Extra{$name}; # Perl function to execute 620 $fn = $name unless $fn; # If none specified, use command name 621 unless (&dynload'load('cmdenv', $Path{$name}, $fn)) { 622 &'add_log("ERROR cannot load script for command $name") if $'loglvl; 623 print MAILER "Cannot load $name command.\n"; 624 return 1; # Failed 625 } 626 # Place in the cmdenv package context and call the function, propagating 627 # the error status (1 for failure). Arguments are pre-split on space, 628 # simply for convenience, but the command is free to parse the 'cmd' 629 # variable itself. 630 package cmdenv; 631 local(*MAILER) = *cmdserv'MAILER; # Propagate file descriptor 632 local($fn) = $cmdserv'fn; # Propagate function name 633 local(@argv) = split(' ', $cmd); 634 shift(@argv); # Remove command name 635 local($res) = eval('&$fn(@argv)'); # Call function, get status 636 if (chop $@) { 637 &'add_log("ERROR in perl $name: $@") if $'loglvl; 638 print MAILER "Perl error: $@\n"; 639 $res = 1; 640 } 641 $res; # Propagate error status 642} 643 644# Help command. Start by looking in the user's help directory, then in 645# the public mailagent help directory. Users may disable help for a 646# command by making an empty file in their own help dir. 647sub exec_help { 648 local(@topic) = split(' ', $cmdenv'cmd); 649 local($topic) = $topic[1]; # Help topic wanted 650 local($help); # Help file 651 unless ($topic) { # General builin help 652 # Doesn't work with a here document form... (perl 4.0 PL36) 653 print MAILER 654"Following is a list of the known commands. Some additional help is available 655on a command basis by using 'help <command>', unless the command name is 656followed by a '*' character in which case no further help may be obtained. 657Commands collecting input until an EOF mark are flagged with a trailing '='. 658 659"; 660 local(@cmds); # List of known commands 661 local($star); # Does command have a help file? 662 local($plus); # Does command require additional input? 663 local($online) = 0; # Number of commands currently printed on line 664 local($print); # String printed for each command 665 local($fieldlen) = 18; # Amount of space dedicated to each command 666 push(@cmds, keys(%Builtin), keys(%Command)); 667 foreach $cmd (sort @cmds) { 668 $help = "$cf'helpdir/$cmd"; 669 $help = "$'privlib/help/$cmd" unless -e $help; 670 $star = -s $help ? '' : '*'; 671 $plus = defined($Collect{$cmd}) ? '=' : ''; 672 # We print 4 commands on a single line 673 $print = $cmd . $plus . $star; 674 print MAILER $print, ' ' x ($fieldlen - length($print)); 675 if ($online++ == 3) { 676 $online = 0; 677 print MAILER "\n"; 678 } 679 } 680 print MAILER "\n" if $online; # Pending line not completed yet 681 print MAILER "\nEnd of command list.\n"; 682 return 0; # Ok 683 } 684 $help = "$cf'helpdir/$topic"; 685 $help = "$'privlib/help/$cmd" unless -e $help; 686 unless (-s $help) { 687 print MAILER "Help for '$topic' is not available.\n"; 688 return 0; # Not a failure 689 } 690 &include($help, "$topic help", ''); # Include file and propagate status 691} 692 693# 694# Builtins 695# 696 697# Approve command in advance by specifying a password. The syntax is: 698# approve <password> [command] 699# and the password is simply recorded in the command environment. Then parsing 700# of the command is resumed. 701# NOTE: cannot approve a command which collects input (yet). 702sub run_approve { 703 local($x, $password, @command) = split(' ', $cmdenv'cmd); 704 $cmdenv'approve = $password; # Save approve password 705 &cmdenv'set_cmd(join(' ', @command)); # Set command environment 706 &dispatch; # Execute command and propagate status 707} 708 709# Ask for new power. The syntax is: 710# power <name> <password> 711# Normally, 'root' does not need to request for any other powers, less give 712# any password. However, for simplicity and uniformity, we simply grant it 713# with no checks. 714sub run_power { 715 local($x, $name, $password) = split(' ', $cmdenv'cmd); 716 if (!$cmdenv'trusted) { # Server has to be running in trusted mode 717 &power'add_log("WARNING cannot gain power '$name': not in trusted mode") 718 if $'loglvl > 5; 719 } elsif (&root || &power'grant($name, $password, $cmdenv'uid)) { 720 &power'add_log("granted power '$name' to $cmdenv'uid") if $'loglvl > 2; 721 &cmdenv'addpower($name); 722 return 0; # Ok 723 } 724 print MAILER "Permission denied.\n"; 725 1; # Failed 726} 727 728# Release power. The syntax is: 729# release <name> 730# If the 'root' power is released, other powers obtained while root or before 731# are kept. That way, it makes sense to ask for powers as root when the 732# password for some power has been changed. It is wise to release a power once 733# it is not needed anymore, since it may prevent mistakes. 734sub run_release { 735 local($x, $name) = split(' ', $cmdenv'cmd); 736 &cmdenv'rempower($name); 737 0; # Always ok 738} 739 740# List all powers with their clearances. The syntax is: 741# powers <regexp> 742# and the 'system' power is needed to get the list. The root power or security 743# power is needed to get the root or security information. If no arguments are 744# specified, all the non-privileged powers (if you do not have root or security 745# clearance) are listed. If arguments are given, they are taken as regular 746# expression filters (perl way). 747sub run_powers { 748 local($x, @regexp) = split(' ', $cmdenv'cmd); 749 unless (&cmdenv'haspower('system') || &cmdenv'haspower('security')) { 750 print MAILER "Permission denied.\n"; 751 return 1; 752 } 753 unless (open(PASSWD, $cf'passwd)) { 754 &power'add_log("ERROR cannot open password file $cf'passwd: $!") 755 if $'loglvl; 756 print MAILER "Cannot open password file ($!).\n"; 757 return 1; 758 } 759 print MAILER "List of currently defined powers:\n"; 760 local($_); 761 local($power); # Current power analyzed 762 local($matched); # Did power match the regular expression? 763 while (<PASSWD>) { 764 ($power) = split(/:/); 765 # If any of the following regular expressions is incorrect, a die will 766 # be generated and caught by the enclosing eval. 767 $matched = @regexp ? 0 : 1; 768 foreach $regexp (@regexp) { 769 eval '$power =~ /$regexp/ && ++$matched;'; 770 if (chop($@)) { 771 print MAILER "Perl failure: $@\n"; 772 $@ = ''; 773 close PASSWD; 774 return 1; 775 } 776 last if $matched; 777 } 778 next unless $matched; 779 print MAILER "\nPower: $power\n"; 780 if ( 781 ($power eq 'root' || $power eq 'security') && 782 !&cmdenv'haspower($power) 783 ) { 784 print MAILER "(Cannot list clearance file: permission denied.)\n"; 785 next; 786 } 787 &include(&power'authfile($power), "$power clearance"); 788 } 789 close PASSWD; 790 0; 791} 792 793# Set new power password. The syntax is: 794# password <name> <new> 795# To change a power password, you need to get the corresponding power or be 796# system, hence showing you know the password for that power or have greater 797# privileges. To change the 'root' and 'security' passwords, you need the 798# corresponding security clearance. 799sub run_password { 800 local($x, $name, $new) = split(' ', $cmdenv'cmd); 801 local($required) = $name; 802 $required = 'system' unless &cmdenv'haspower($name); 803 $required = $name if $name eq 'root' || $name eq 'security'; 804 unless (&cmdenv'haspower($required)) { 805 print MAILER "Permission denied (not enough power).\n"; 806 &power'add_log("ERROR $cmdenv'uid tried a password change for '$name'") 807 if $'loglvl > 1; 808 return 1; 809 } 810 return &change_password($name, $new); 811} 812 813# Set new power password. The syntax is: 814# passwd <name> <old> <new> 815# You do not need to have the corresponding power to change the password since 816# the old password is requested. This is a short for the sequence: 817# power <name> <old> 818# password <name> <new> 819# release <name> 820# excepted that even root has to give the correct old password if this form 821# is used. 822sub run_passwd { 823 local($x, $name, $old, $new) = split(' ', $cmdenv'cmd); 824 unless (&power'authorized($name, $cmdenv'uid)) { 825 &power'add_log("ERROR $cmdenv'uid tried a password change for '$name'") 826 if $'loglvl > 1; 827 print MAILER "Permission denied (lacks authorization).\n"; 828 return 1; 829 } 830 unless (&power'valid($name, $old)) { 831 &power'add_log("ERROR $cmdenv'uid gave wrong old password for '$name'") 832 if $'loglvl > 1; 833 print MAILER "Permission denied (invalid pasword).\n"; 834 return 1; 835 } 836 return &change_password($name, $new); 837} 838 839# Change password for power 'name' to be $new. 840# All security checks have been performed at this point, so we may indeed 841# attempt the change. Note that this subroutine is common for the two 842# passwd and password commands. 843# Returns 0 if OK, 1 on error. 844sub change_password { 845 local($name, $new) = @_; 846 if (0 == &power'set_passwd($name, $new)) { 847 &power'add_log("user $cmdenv'uid changed password for power '$name'") 848 if $'loglvl > 2; 849 return 0; 850 } 851 &power'add_log("ERROR user $cmdenv'uid failed change password for '$name'") 852 if $'loglvl > 1; 853 print MAILER "Could not change password, sorry.\n"; 854 1; 855} 856 857# Change user ID, i.e. e-mail address. The syntax is: 858# user [<email> [command]] 859# and is used to execute some commands on behalf of another user. If a command 860# is specified, it is immediately executed with the new identity, which only 861# lasts for that time. Otherwise, the remaining commands are executed with that 862# new ID. If no email is specified, the original sender ID is restored. 863# All the powers are lost when a user command is executed, but this is only 864# temporary when the command is specified on the same line. 865sub run_user { 866 local($x, $user, @command) = split(' ', $cmdenv'cmd); 867 local(%powers); 868 local($powers); 869 if (0 == @command && $cmdenv'powers ne '') { 870 print MAILER "Wiping out current powers ($cmdenv'powers).\n"; 871 &cmdenv'wipe_powers; 872 } 873 if (0 != @command && $cmdenv'powers ne '') { 874 %powers = %cmdenv'powers; 875 $powers = $cmdenv'powers; 876 print MAILER "Current powers temporarily lost ($cmdenv'powers).\n"; 877 &cmdenv'wipe_powers; 878 } 879 unless ($user) { # Reverting to original sender ID 880 $cmdenv'user = $cmdenv'uid; 881 print MAILER "Back to original identity ($cmdenv'uid).\n"; 882 return 0; 883 } 884 if (0 == @command) { 885 $cmdenv'user = $user; 886 print MAILER "New user identity: $cmdenv'user.\n"; 887 return 0; 888 } 889 890 &cmdenv'set_cmd(join(' ', @command)); # Set command environment 891 local($failed) = &dispatch; # Execute command 892 893 if (%powers) { 894 $cmdenv'powers = $powers; 895 %cmdenv'powers = %powers; 896 print MAILER "Restored powers ($powers).\n"; 897 } 898 899 $failed; # Propagate failure status 900} 901 902# Add a new power to the system. The syntax is: 903# newpower <name> <password> [alias] 904# followed by a list of approved names who may request that power. The 'system' 905# power is required to add a new power. An alias should be specified if the 906# name is longer than 12 characters. The 'security' power is required to create 907# the root power, and root power is needed to create 'security'. 908sub run_newpower { 909 local($x, $name, $password, $alias) = split(' ', $cmdenv'cmd); 910 if ( 911 ($name eq 'root' && !&cmdenv'haspower('security')) || 912 ($name eq 'security' && !&cmdenv'haspower('root')) || 913 !&cmdenv'haspower('system') 914 ) { 915 print MAILER "Permission denied.\n"; 916 return 1; 917 } 918 &newpower($name, $password, $alias); 919} 920 921# Actually add the new power to the system, WITHOUT any security checks. It 922# is up to the called to ensure the user has correct permissions. Return 0 923# if ok and 1 on error. 924# The clearance list is taken from @cmdenv'buffer. 925sub newpower { 926 local($name, $password, $alias) = @_; 927 local($power) = &power'getpwent($name); 928 if (defined $power) { 929 print MAILER "Power '$name' already exists.\n"; 930 return 1; 931 } 932 if (length($name) > 12 && !defined($alias)) { 933 # Compute a suitable alias name, which never appears externally anyway 934 # so it's not really important to use cryptic ones. First, reduce the 935 # power name to 10 characters. 936 $alias = $name; 937 $alias =~ tr/aeiouy//d; 938 $alias = substr($alias, 0, 6) . substr($alias, -6); 939 if (&power'used_alias($alias)) { 940 $alias = substr($alias, 0, 10); 941 local($tag) = 'AA'; 942 local($try) = 100; 943 local($attempt); 944 while ($try--) { 945 $attempt = "$alias$tag"; 946 last unless &power'used_alias($attempt); 947 $tag++; 948 } 949 $alias = $attempt; 950 if (&power'used_alias($alias)) { 951 print MAILER "Cannot auto-select any unused alias.\n"; 952 return 1; # Failed 953 } 954 } 955 print MAILER "(Selecting alias '$alias' for this power.)\n"; 956 } 957 # Make sure alias is not too long. Don't try to shorten any user-specified 958 # alias if they took care of giving one instead of letting mailagent 959 # pick one up... 960 if (defined($alias) && length($alias) > 12) { 961 print MAILER "Alias name too long (12 characters max).\n"; 962 return 1; 963 } 964 if (defined($alias) && &power'used_alias($alias)) { 965 print MAILER "Alias '$alias' is already in use.\n"; 966 return 1; 967 } 968 if (defined($alias) && !&power'add_alias($name, $alias)) { 969 print MAILER "Cannot add alias, sorry.\n"; 970 return 1; 971 } 972 unless (&power'set_auth($name, *cmdenv'buffer)) { 973 print MAILER "Cannot set authentication file, sorry.\n"; 974 return 1; 975 } 976 if (-1 == &power'setpwent($name, "<$password>", '')) { 977 print MAILER "Cannot add power, sorry.\n"; 978 return 1; 979 } 980 if (-1 == &power'set_passwd($name, $password)) { 981 print MAILER "Warning: could not insert password.\n"; 982 } 983 &power'add_log("NEW power '$name' created by $cmdenv'uid") if $'loglvl > 2; 984 0; 985} 986 987# Delete a power from the system. The syntax is: 988# delpower <name> <password> [<security>] 989# deletes a power and its associated user list. The 'system' power is required 990# to delete most powers except 'root' and 'security'. The 'security' power may 991# only be deleted by security and the root power may only be deleted when the 992# security password is also specified. 993sub run_delpower { 994 local($x, $name, $password, $security) = split(' ', $cmdenv'cmd); 995 if ( 996 ($name eq 'security' && !&cmdenv'haspower($name)) || 997 ($name eq 'root' && !&power'valid('security', $security)) || 998 !&cmdenv'haspower('system') 999 ) { 1000 print MAILER "Permission denied (not enough power).\n"; 1001 return 1; 1002 } 1003 unless (&root) { 1004 unless (&power'valid($name, $password)) { 1005 print MAILER "Permission denied (invalid password).\n"; 1006 return 1; 1007 } 1008 } 1009 &delpower($name); 1010} 1011 1012# Actually delete a power from the system, WITHOUT any security checks. It 1013# is up to the called to ensure the user has correct permissions. Return 0 1014# if ok and 1 on error. 1015sub delpower { 1016 local($name) = @_; 1017 local($power) = &power'getpwent($name); 1018 if (!defined $power) { 1019 print MAILER "Power '$name' does not exist.\n"; 1020 return 1; 1021 } 1022 local($auth) = &power'authfile($name); 1023 if ($auth ne '/dev/null' && !unlink($auth)) { 1024 &'add_log("SYSERR unlink: $!") if $'loglvl; 1025 &'add_log("ERROR could not remove clearance file $auth") if $'loglvl; 1026 print MAILER "Warning: could not remove clearance file.\n"; 1027 } 1028 unless (&power'del_alias($name)) { 1029 print MAILER "Warning: could not remove power alias.\n"; 1030 } 1031 if (0 != &power'rempwent($name)) { 1032 print MAILER "Failed (cannot remove password entry).\n"; 1033 return 1; 1034 } 1035 &power'add_log("DELETED power '$name' by $cmdenv'uid") if $'loglvl > 2; 1036 0; 1037} 1038 1039# Replace current clearance file. The syntax is: 1040# setauth <name> <password> 1041# and requires no special power if the password is given or if the power is 1042# already detained. Otherwise, the system power is needed. For 'root' and 1043# 'security' clearances, the corresponding power is needed as well. 1044sub run_setauth { 1045 local($x, $name, $password) = split(' ', $cmdenv'cmd); 1046 local($required) = $name; 1047 $required = 'system' unless &cmdenv'haspower($name); 1048 $required = $name if $name eq 'root' || $name eq 'security'; 1049 unless (&cmdenv'haspower($required)) { 1050 unless (&power'valid($name, $password)) { 1051 print MAILER "Permission denied.\n"; 1052 return 1; 1053 } 1054 } 1055 unless (&power'set_auth($name, *cmdenv'buffer)) { 1056 print MAILER "Cannot set authentication file, sorry.\n"; 1057 return 1; 1058 } 1059 0; 1060} 1061 1062# Add users to clearance file. The syntax is: 1063# addauth <name> <password> 1064# and requires no special power if the password is given or if the power is 1065# already detained. Otherwise, the system power is needed. For 'root' and 1066# 'security' clearances, the corresponding power is needed as well. 1067sub run_addauth { 1068 local($x, $name, $password) = split(' ', $cmdenv'cmd); 1069 local($required) = $name; 1070 $required = 'system' unless &cmdenv'haspower($name); 1071 $required = $name if $name eq 'root' || $name eq 'security'; 1072 unless (&cmdenv'haspower($required)) { 1073 unless (&power'valid($name, $password)) { 1074 print MAILER "Permission denied.\n"; 1075 return 1; 1076 } 1077 } 1078 unless (&power'add_auth($name, *cmdenv'buffer)) { 1079 print MAILER "Cannot add to authentication file, sorry.\n"; 1080 return 1; 1081 } 1082 0; 1083} 1084 1085# Remove users from clearance file. The syntax is: 1086# remauth <name> <password> 1087# and requires no special power if the password is given or if the power is 1088# already detained. Otherwise, the system power is needed. For 'root' and 1089# 'security' clearances, the corresponding power is needed as well. 1090sub run_remauth { 1091 local($x, $name, $password) = split(' ', $cmdenv'cmd); 1092 local($required) = $name; 1093 $required = 'system' unless &cmdenv'haspower($name); 1094 $required = $name if $name eq 'root' || $name eq 'security'; 1095 unless (&cmdenv'haspower($required)) { 1096 unless (&power'valid($name, $password)) { 1097 print MAILER "Permission denied.\n"; 1098 return 1; 1099 } 1100 } 1101 unless (&power'rem_auth($name, *cmdenv'buffer)) { 1102 print MAILER "Cannot remove from authentication file, sorry.\n"; 1103 return 1; 1104 } 1105 0; 1106} 1107 1108# Get current clearance file. The syntax is: 1109# getauth <name> <password> 1110# and requires no special power if the password is given or if the power is 1111# already detained. Otherwise, the system power is needed for all powers, 1112# and for 'root' or 'security', the corresponding power is required. 1113sub run_getauth { 1114 local($x, $name, $password) = split(' ', $cmdenv'cmd); 1115 local($required) = $name; 1116 $required = 'system' unless &cmdenv'haspower($name); 1117 $required = $name if $name eq 'root' || $name eq 'security'; 1118 unless (&cmdenv'haspower($required)) { 1119 unless (&power'valid($name, $password)) { 1120 print MAILER "Permission denied.\n"; 1121 return 1; 1122 } 1123 } 1124 local($file) = &power'authfile($name); 1125 &include($file, "$name clearance", ''); # Include file, propagate status 1126} 1127 1128# Set internal variable. The syntax is: 1129# set <variable> <value> 1130# and the corresponding variable from cmdenv package is set. 1131# If <variable> is missing, dump all the known variables. 1132sub run_set { 1133 local($x, $var, @args) = split(' ', $cmdenv'cmd); 1134 if ($var eq '') { # Dump defined variables 1135 local($type, $val); 1136 foreach $name (keys %Set) { 1137 $type = $Set{$name}; # Variable type 'flag' or 'var' 1138 $val = eval "defined(\$cmdenv'$name) ? \$cmdenv'$name : undef"; 1139 next unless defined $val; 1140 $val = $val ? 'true' : 'false' if $type eq 'flag'; 1141 $val = "'$val'" if $type ne 'flag'; 1142 print MAILER "$name=$val\n"; 1143 } 1144 return 0; 1145 } 1146 unless (defined $Set{$var}) { 1147 print MAILER "Unknown or read-only variable '$var'.\n"; 1148 return 1; # Failed 1149 } 1150 local($type) = $Set{$var}; # The variable type 1151 local($_); # Value to assign to variable 1152 local($val); # Final assigned value 1153 if ($type eq 'flag') { 1154 $_ = $args[0]; 1155 if ($_ eq '' || /on/i || /yes/i || /true/i) { 1156 $val = 1; 1157 } else { 1158 $val = 0; 1159 } 1160 } else { 1161 $val = join(' ', @args); 1162 } 1163 eval "\$cmdenv'$var = \$val"; # Set variable in cmdenv package 1164 0; 1165} 1166 1167# 1168# Utilities 1169# 1170 1171# Emit the user prompt in transcript, then copy current line 1172sub user_prompt { 1173 if (&root) { 1174 print MAILER "####> "; # Command with no restrictions at all 1175 } elsif ($cmdenv'powers ne '') { 1176 print MAILER "====> "; # Command with local privileges 1177 } elsif ($cmdenv'user ne $cmdenv'uid) { 1178 print MAILER "~~~~> "; # Command on behalf of another user 1179 } else { 1180 print MAILER "----> "; # Command from and for current user 1181 } 1182 print MAILER "$cmdenv'log\n"; 1183} 1184 1185# Include file in transcript, returning 1 on failure and 0 on success 1186# If the third parameter is given, then it is used as leading marks, and 1187# the enclosing digest lines are omitted. 1188sub include { 1189 local($file, $description, $marks) = @_; 1190 unless (open(FILE, $file)) { 1191 &'add_log("ERROR cannot open $file: $!") if $'loglvl; 1192 print MAILER "Cannot open $description file ($!).\n"; 1193 return 1; 1194 } 1195 local($_); 1196 print MAILER " --- Beginning of file ($description) ---\n" 1197 unless defined $marks; 1198 while (<FILE>) { 1199 (print MAILER) unless defined $marks; 1200 (print MAILER $marks, $_) if defined $marks; 1201 } 1202 close FILE; 1203 print MAILER " --- End of file ($description) ---\n" 1204 unless defined $marks; 1205 0; # Success 1206} 1207 1208# Signals end of processing 1209sub finish { 1210 local($why) = @_; 1211 print MAILER "End of processing ($why)\n"; 1212 &'add_log("END ($why)") if $'loglvl > 6; 1213} 1214 1215# Check whether user has root powers or not. 1216sub root { 1217 &cmdenv'haspower('root'); 1218} 1219 1220# 1221# Server modes 1222# 1223 1224# Allow server to run in trusted mode (where powers may be gained). 1225sub trusted { 1226 if ($cmdenv'auth) { # Valid envelope in mail header 1227 $cmdenv'trusted = 1; # Allowed to gain powers 1228 } else { 1229 &'add_log("WARNING unable to switch into trusted mode") 1230 if $'loglvl > 5; 1231 } 1232} 1233 1234# Disable a list of commands, and only those commands. 1235sub disable { 1236 local($cmds) = @_; # List of disabled commands 1237 undef %Disabled; # Reset disabled commands, start with fresh set 1238 foreach $cmd (split(/[\s,]+/, $cmds)) { 1239 $Disabled{$cmd}++; 1240 } 1241 $cmdenv'disabled = join(',', sort keys %Disabled); # No duplicates 1242} 1243 1244# Get shell to run our commands 1245sub servshell { 1246 local($shell) = defined($cf'servshell) ? $cf'servshell : 'sh'; 1247 $shell = &'locate_program($shell); 1248 if (defined($cf'servshell) && !-x($shell)) { 1249 &'add_log("WARNING invalid configured servshell $shell, using sh") 1250 if $'loglvl > 2; 1251 $shell = 'sh'; 1252 } 1253 $shell; 1254} 1255 1256# 1257# Environment for server commands 1258# 1259 1260package cmdenv; 1261 1262# Set user identification (e-mail address) within cmdenv package 1263sub inituid { 1264 # Convenience variables are part of the basic environment for all the 1265 # server commands. This includes the $envelope variable, which is the 1266 # user who has issued the request (real uid). 1267 &hook'initvar('cmdenv'); 1268 $auth = 1; # Assume valid envelope 1269 $uid = (&'parse_address($envelope))[0]; 1270 if ($uid eq '') { # No valid envelope 1271 &'add_log("NOTICE no valid mail envelope") if $'loglvl > 6; 1272 $uid = (&'parse_address($sender))[0]; 1273 $auth = 0; # Will not be able to run in trusted mode 1274 } 1275 $user = $uid; # Until further notice, euid = ruid 1276 $path = $uid; # And files are sent to the one who requested them 1277 undef %powers; # Reset power table 1278 $powers = ''; # The linear version of powers 1279 $errors = 0; # Number of failed requests so far 1280 $requests = 0; # Total number of requests processed so far 1281 $eof = 'EOF'; # End of file indicator in collection mode 1282 $collect = 0; # Not in collection mode 1283 $trace = 0; # Not in trace mode 1284 $trusted = 0; # Not in trusted mode 1285} 1286 1287# Set command parameters 1288sub set_cmd { 1289 ($cmd) = @_; 1290 ($name) = $cmd =~ /^([\w-]+)/; # Get command name 1291 $name =~ tr/A-Z/a-z/; # Cannonicalize to lower case 1292 1293 # Passwords in commands may need to be concealed 1294 if (defined $cmdserv'Conceal{$name}) { 1295 local(@argv) = split(' ', $cmd); 1296 local(@pos) = split(/,/, $cmdserv'Conceal{$name}); 1297 foreach $pos (@pos) { 1298 $argv[$pos] = '********' if defined $argv[$pos]; 1299 } 1300 $log = join(' ', @argv); 1301 } else { 1302 $log = $cmd; 1303 } 1304} 1305 1306# Add a new power to the list once the user has been authenticated. 1307sub addpower { 1308 local($newpower) = @_; 1309 $powers{$newpower}++; 1310 $powers = join(':', keys %powers); 1311} 1312 1313# Remove power from the list. 1314sub rempower { 1315 local($oldpower) = @_; 1316 delete $powers{$oldpower}; 1317 $powers = join(':', keys %powers); 1318} 1319 1320# Wipe out all the powers 1321sub wipe_powers { 1322 undef %powers; 1323 $powers = ''; 1324} 1325 1326# Check whether user has a given power... Note that 'root' has all powers 1327# but 'security'. 1328sub haspower { 1329 local($wanted) = @_; 1330 $wanted eq 'security' ? 1331 defined($powers{$wanted}) : 1332 (defined($powers{'root'}) || defined($powers{$wanted})); 1333} 1334 1335package main; 1336 1337