home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume44 / mailagent / patch14 < prev    next >
Encoding:
Internet Message Format  |  1994-09-22  |  45.3 KB
  1. From: Raphael Manfredi <ram@acri.fr>
  2. Newsgroups: comp.sources.misc
  3. Subject: v44i088:  mailagent - Flexible mail filtering and processing package, v3.0, Patch14
  4. Date: 22 Sep 1994 12:13:09 -0500
  5. Organization: Advanced Computer Research Institute, Lyon, France
  6. Sender: kent@sparky.sterling.com
  7. Approved: kent@sparky.sterling.com
  8. Message-ID: <35sdv5$r5c@sparky.sterling.com>
  9. X-Md4-Signature: e92b7f719734101e1dc4f203bab5ae54
  10.  
  11. Submitted-by: Raphael Manfredi <ram@acri.fr>
  12. Posting-number: Volume 44, Issue 88
  13. Archive-name: mailagent/patch14
  14. Environment: UNIX, Perl
  15. Patch-To: mailagent: Volume 41, Issue 1-26
  16.  
  17. [The latest patch for mailagent version 3.0 is #16.]
  18.  
  19. System: mailagent version 3.0
  20. Patch #: 14
  21. Priority: MEDIUM
  22. Subject: patch #12, continued
  23. Date: Thu Sep 22 17:04:34 MET DST 1994
  24. From: Raphael Manfredi <ram@acri.fr>
  25.  
  26. Description:
  27.     See patch #12.
  28.  
  29.  
  30. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your mailagent source
  31.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  32.     If you don't have the patch program, apply the following by hand,
  33.     or get patch (version 2.0, latest patchlevel).
  34.  
  35.     After patching:
  36.         *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #16 FIRST ***
  37.  
  38.     If patch indicates that patchlevel is the wrong version, you may need
  39.     to apply one or more previous patches, or the patch may already
  40.     have been applied.  See the patchlevel.h file to find out what has or
  41.     has not been applied.  In any event, don't continue with the patch.
  42.  
  43.     If you are missing previous patches they can be obtained from me:
  44.  
  45.         Raphael Manfredi <ram@acri.fr>
  46.  
  47.     If you send a mail message of the following form it will greatly speed
  48.     processing:
  49.  
  50.         Subject: Command
  51.         @SH mailpatch PATH mailagent 3.0 LIST
  52.                ^ note the c
  53.  
  54.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  55.     or in bang notation from some well-known host, and LIST is the number
  56.     of one or more patches you need, separated by spaces, commas, and/or
  57.     hyphens.  Saying 35- says everything from 35 to the end.
  58.  
  59.     To get some more detailed instructions, send me the following mail:
  60.  
  61.         Subject: Command
  62.         @SH mailhelp PATH
  63.  
  64.  
  65. Index: patchlevel.h
  66. Prereq: 13
  67. 4c4
  68. < #define PATCHLEVEL 13
  69. ---
  70. > #define PATCHLEVEL 14
  71.  
  72. Index: agent/pl/eval.pl
  73. Prereq: 3.0
  74. *** agent/pl/eval.pl.old    Thu Sep 22 16:43:09 1994
  75. --- agent/pl/eval.pl    Thu Sep 22 16:43:09 1994
  76. ***************
  77. *** 1,4 ****
  78. ! ;# $Id: eval.pl,v 3.0 1993/11/29 13:48:42 ram Exp $
  79.   ;#
  80.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  81.   ;#  
  82. --- 1,4 ----
  83. ! ;# $Id: eval.pl,v 3.0.1.1 1994/09/22 14:18:11 ram Exp $
  84.   ;#
  85.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  86.   ;#  
  87. ***************
  88. *** 9,14 ****
  89. --- 9,17 ----
  90.   ;#  of the source tree for mailagent 3.0.
  91.   ;#
  92.   ;# $Log: eval.pl,v $
  93. + ;# Revision 3.0.1.1  1994/09/22  14:18:11  ram
  94. + ;# patch12: replaced all deprecated 'do sub' calls with '&sub'
  95. + ;#
  96.   ;# Revision 3.0  1993/11/29  13:48:42  ram
  97.   ;# Baseline for mailagent 3.0 netwide release.
  98.   ;#
  99. ***************
  100. *** 19,26 ****
  101.   
  102.   # Initialize the interpreter
  103.   sub init_interpreter {
  104. !     do set_priorities();    # Fill in %Priority
  105. !     do set_functions();        # Fill in %Function
  106.       $macro_T = "the Epoch";    # Default value for %T macro substitution
  107.   }
  108.   
  109. --- 22,29 ----
  110.   
  111.   # Initialize the interpreter
  112.   sub init_interpreter {
  113. !     &set_priorities;        # Fill in %Priority
  114. !     &set_functions;            # Fill in %Function
  115.       $macro_T = "the Epoch";    # Default value for %T macro substitution
  116.   }
  117.   
  118. ***************
  119. *** 57,63 ****
  120.   
  121.   # Print error messages -- asssumes $unit and $. correctly set.
  122.   sub error {
  123. !     do add_log("ERROR @_") if $loglvl > 1;
  124.   }
  125.   
  126.   # Add a value on the stack, modified by all the monadic operators.
  127. --- 60,66 ----
  128.   
  129.   # Print error messages -- asssumes $unit and $. correctly set.
  130.   sub error {
  131. !     &add_log("ERROR @_") if $loglvl > 1;
  132.   }
  133.   
  134.   # Add a value on the stack, modified by all the monadic operators.
  135. ***************
  136. *** 81,89 ****
  137.       local($val2) = pop(@val);        # Right value in algebraic notation
  138.       local($val1) = pop(@val);        # Left value in algebraic notation
  139.       local($func) = $Function{$op};    # Function to be called
  140. !     do macros_subst(*val1);            # Expand macros
  141. !     do macros_subst(*val2);
  142. !     push(@val, eval("do $func($val1, $val2)") ? 1: 0);
  143.   }
  144.   
  145.   # Given an operator, either we add it in the stack @op, because its
  146. --- 84,92 ----
  147.       local($val2) = pop(@val);        # Right value in algebraic notation
  148.       local($val1) = pop(@val);        # Left value in algebraic notation
  149.       local($func) = $Function{$op};    # Function to be called
  150. !     ¯os_subst(*val1);            # Expand macros
  151. !     ¯os_subst(*val2);
  152. !     push(@val, eval("&$func($val1, $val2)") ? 1: 0);
  153.   }
  154.   
  155.   # Given an operator, either we add it in the stack @op, because its
  156. ***************
  157. *** 94,104 ****
  158.   sub update_stack {
  159.       local($op) = shift(@_);        # Operator
  160.       if (!$Priority{$op}) {
  161. !         do error("illegal operator $op");
  162.           return;
  163.       } else {
  164.           if ($#val < 0) {
  165. !             do error("missing first operand for '$op' (diadic operator)");
  166.               return;
  167.           }
  168.           # Because of a bug in perl 4.0 PL19, I'm using a loop construct
  169. --- 97,107 ----
  170.   sub update_stack {
  171.       local($op) = shift(@_);        # Operator
  172.       if (!$Priority{$op}) {
  173. !         &error("illegal operator $op");
  174.           return;
  175.       } else {
  176.           if ($#val < 0) {
  177. !             &error("missing first operand for '$op' (diadic operator)");
  178.               return;
  179.           }
  180.           # Because of a bug in perl 4.0 PL19, I'm using a loop construct
  181. ***************
  182. *** 107,113 ****
  183.               $Priority{$op[$#op]} > $Priority{$op}    # Higher priority op
  184.               && $#val > 0                            # At least 2 values
  185.           ) {
  186. !             do execute();    # Execute an higer priority stacked operation
  187.           }
  188.           push(@op, $op);        # Everything at higher priority has been executed
  189.       }
  190. --- 110,116 ----
  191.               $Priority{$op[$#op]} > $Priority{$op}    # Higher priority op
  192.               && $#val > 0                            # At least 2 values
  193.           ) {
  194. !             &execute;    # Execute an higer priority stacked operation
  195.           }
  196.           push(@op, $op);        # Everything at higher priority has been executed
  197.       }
  198. ***************
  199. *** 127,169 ****
  200.           # A perl statement <<command>>
  201.           if (s/^<<//) {
  202.               if (s/^(.*)>>//) {
  203. !                 do push_val((system
  204.                       ('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
  205.                       ))? 0 : 1);
  206.               } else {
  207. !                 do error("incomplete perl statement");
  208.               }
  209.           }
  210.           # A shell statement <command>
  211.           elsif (s/^<//) {
  212.               if (s/^(.*)>//) {
  213. !                 do push_val((system
  214.                       ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
  215.                       ))? 0 : 1);
  216.               } else {
  217. !                 do error("incomplete shell statement");
  218.               }
  219.           }
  220.           # The '(' construct
  221.           elsif (s/^\(//) {
  222. !             do push_val(do eval_expr(*_));
  223.               # A final '\' indicates an end of line
  224. !             do error("missing final parenthesis") if !s/^\\//;
  225.           }
  226.           # Found a ')' or end of line
  227.           elsif (/^\)/ || /^$/) {
  228.               s/^\)/\\/;                        # Signals: left parenthesis found
  229.               $expr = $_;                        # Remove interpreted stuff
  230. !             do execute() while $#val > 0;    # Executed stacked operations
  231.               while ($#op >= 0) {
  232.                   $_ = pop(@op);
  233. !                 do error("missing second operand for '$_' (diadic operator)");
  234.               }
  235.               return $val[0];
  236.           }
  237.           # Diadic operators
  238.           elsif (s/^(\|\||&&|>=|<=|>|<|==|!=|=|\/=)//) {
  239. !             do update_stack($1);
  240.           }
  241.           # Unary operator '!'
  242.           elsif (s/^!//) {
  243. --- 130,172 ----
  244.           # A perl statement <<command>>
  245.           if (s/^<<//) {
  246.               if (s/^(.*)>>//) {
  247. !                 &push_val((system
  248.                       ('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
  249.                       ))? 0 : 1);
  250.               } else {
  251. !                 &error("incomplete perl statement");
  252.               }
  253.           }
  254.           # A shell statement <command>
  255.           elsif (s/^<//) {
  256.               if (s/^(.*)>//) {
  257. !                 &push_val((system
  258.                       ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
  259.                       ))? 0 : 1);
  260.               } else {
  261. !                 &error("incomplete shell statement");
  262.               }
  263.           }
  264.           # The '(' construct
  265.           elsif (s/^\(//) {
  266. !             &push_val(&eval_expr(*_));
  267.               # A final '\' indicates an end of line
  268. !             &error("missing final parenthesis") if !s/^\\//;
  269.           }
  270.           # Found a ')' or end of line
  271.           elsif (/^\)/ || /^$/) {
  272.               s/^\)/\\/;                        # Signals: left parenthesis found
  273.               $expr = $_;                        # Remove interpreted stuff
  274. !             &execute while $#val > 0;        # Executed stacked operations
  275.               while ($#op >= 0) {
  276.                   $_ = pop(@op);
  277. !                 &error("missing second operand for '$_' (diadic operator)");
  278.               }
  279.               return $val[0];
  280.           }
  281.           # Diadic operators
  282.           elsif (s/^(\|\||&&|>=|<=|>|<|==|!=|=|\/=)//) {
  283. !             &update_stack($1);
  284.           }
  285.           # Unary operator '!'
  286.           elsif (s/^!//) {
  287. ***************
  288. *** 171,177 ****
  289.           }
  290.           # Everything else is a value which stands for itself (atom)
  291.           elsif (s/^([\w'"%]+)//) {
  292. !             do push_val($1);
  293.           }
  294.           # Syntax error
  295.           else {
  296. --- 174,180 ----
  297.           }
  298.           # Everything else is a value which stands for itself (atom)
  299.           elsif (s/^([\w'"%]+)//) {
  300. !             &push_val($1);
  301.           }
  302.           # Syntax error
  303.           else {
  304. ***************
  305. *** 186,192 ****
  306.       local($val);                    # Value returned
  307.       local(*expr) = shift(@_);        # Expression to be parsed
  308.       while ($expr) {
  309. !         $val = do eval_expr(*expr);        # Expression will be modified
  310.           print "extra closing parenthesis ignored.\n" if $expr =~ s/^\\\)*//;
  311.           $expr = $val . $expr if $expr ne '';
  312.       }
  313. --- 189,195 ----
  314.       local($val);                    # Value returned
  315.       local(*expr) = shift(@_);        # Expression to be parsed
  316.       while ($expr) {
  317. !         $val = &eval_expr(*expr);    # Expression will be modified
  318.           print "extra closing parenthesis ignored.\n" if $expr =~ s/^\\\)*//;
  319.           $expr = $val . $expr if $expr ne '';
  320.       }
  321.  
  322. Index: agent/edusers.SH
  323. *** agent/edusers.SH.old    Thu Sep 22 16:42:47 1994
  324. --- agent/edusers.SH    Thu Sep 22 16:42:47 1994
  325. ***************
  326. *** 0 ****
  327. --- 1,104 ----
  328. + case $CONFIG in
  329. + '')
  330. +     if test -f config.sh; then TOP=.;
  331. +     elif test -f ../config.sh; then TOP=..;
  332. +     elif test -f ../../config.sh; then TOP=../..;
  333. +     elif test -f ../../../config.sh; then TOP=../../..;
  334. +     elif test -f ../../../../config.sh; then TOP=../../../..;
  335. +     else
  336. +         echo "Can't find config.sh."; exit 1
  337. +     fi
  338. +     . $TOP/config.sh
  339. +     ;;
  340. + esac
  341. + case "$0" in
  342. + */*) cd `expr X$0 : 'X\(.*\)/'` ;;
  343. + esac
  344. + echo "Extracting agent/edusers (with variable substitutions)"
  345. + $spitshell >edusers <<!GROK!THIS!
  346. + $startperl
  347. +     eval "exec perl -S \$0 \$*"
  348. +         if \$running_under_some_shell;
  349. + 
  350. + # $Id: edusers.SH,v 3.0.1.1 1994/09/22 13:39:28 ram Exp $
  351. + #
  352. + #  Copyright (c) 1990-1993, Raphael Manfredi
  353. + #  
  354. + #  You may redistribute only under the terms of the Artistic License,
  355. + #  as specified in the README file that comes with the distribution.
  356. + #  You may reuse parts of this distribution only within the terms of
  357. + #  that same Artistic License; a copy of which may be found at the root
  358. + #  of the source tree for mailagent 3.0.
  359. + #
  360. + # $Log: edusers.SH,v $
  361. + # Revision 3.0.1.1  1994/09/22  13:39:28  ram
  362. + # patch12: created
  363. + #
  364. + 
  365. + \$mversion = '$VERSION';
  366. + \$patchlevel = '$PATCHLEVEL';
  367. + \$defeditor = '$defeditor';
  368. + !GROK!THIS!
  369. + $spitshell >>edusers <<'!NO!SUBS!'
  370. + 
  371. + $userlist = "users";
  372. + $prog_name = $0;                # Who I am
  373. + $prog_name =~ s|^.*/(.*)|$1|;    # Keep only base name
  374. + $lockext = '.lock';                # Locking extension
  375. + *add_log = *stderr_log;            # Ensure logs will go to stderr also
  376. + 
  377. + $EDITOR = $ENV{'EDITOR'} || $ENV{'VISUAL'} || $defeditor;
  378. + 
  379. + &read_config;        # First, read configuration file (in ~/.mailagent)
  380. + &read_dist;            # Read distributions
  381. + &catch_signals;
  382. + 
  383. + $system = shift;        # Which system do we want
  384. + $version = shift;        # Which version it is
  385. + 
  386. + # If no system is specified, try locating a '.package', then source it
  387. + # to get information...
  388. + if ($system eq '') {
  389. +     die "$prog_name: you must specify a system name\n" unless &read_package;
  390. +     $system = $pkg'package;
  391. +     $version = $pkg'baserev;
  392. + }
  393. + 
  394. + # A single '-' or a missing version means "highest available" version.
  395. + $version = $Version{$system} if $version eq '-' || $version eq '';
  396. + 
  397. + # Full name of system for H table access
  398. + $pname = $system . "|" . $version;
  399. + 
  400. + die "$prog_name: no program called $system\n" unless $System{$system};
  401. + die "$prog_name: no package $system version $version\n"
  402. +     unless $Program{$pname};
  403. + 
  404. + # Go to the system directory.
  405. + chdir "$Location{$pname}" ||
  406. +     die "$prog_name: cannot go to $Location{$pname}\n";
  407. + 
  408. + -f $userlist || die "$prog_name: no $userlist file yet for $system $version.\n";
  409. + 
  410. + # Lock users file. That file should only be edited with the edusers script.
  411. + die "$prog_name: cannot lock $userlist.\n" if 0 != &acs_rqst($userlist);
  412. + 
  413. + system "$EDITOR $userlist";
  414. + warn "$prog_name: WARNING: edition failed...\n" if $?;
  415. + &free_file($userlist);
  416. + 
  417. + exit $?;
  418. + 
  419. + !NO!SUBS!
  420. + $grep -v '^;#' pl/fatal.pl >>edusers
  421. + $grep -v '^;#' pl/add_log.pl >>edusers
  422. + $grep -v '^;#' pl/read_conf.pl >>edusers
  423. + $grep -v '^;#' pl/distribs.pl >>edusers
  424. + $grep -v '^;#' pl/secure.pl >>edusers
  425. + $grep -v '^;#' pl/acs_rqst.pl >>edusers
  426. + $grep -v '^;#' pl/free_file.pl >>edusers
  427. + $grep -v '^;#' pl/checklock.pl >>edusers
  428. + $grep -v '^;#' pl/signals.pl >>edusers
  429. + $grep -v '^;#' pl/package.pl >>edusers
  430. + chmod 755 edusers
  431. + $eunicefix edusers
  432.  
  433. Index: agent/man/edusers.SH
  434. *** agent/man/edusers.SH.old    Thu Sep 22 16:42:56 1994
  435. --- agent/man/edusers.SH    Thu Sep 22 16:42:56 1994
  436. ***************
  437. *** 0 ****
  438. --- 1,106 ----
  439. + case $CONFIG in
  440. + '')
  441. +     if test -f config.sh; then TOP=.;
  442. +     elif test -f ../config.sh; then TOP=..;
  443. +     elif test -f ../../config.sh; then TOP=../..;
  444. +     elif test -f ../../../config.sh; then TOP=../../..;
  445. +     elif test -f ../../../../config.sh; then TOP=../../../..;
  446. +     else
  447. +         echo "Can't find config.sh."; exit 1
  448. +     fi
  449. +     . $TOP/config.sh
  450. +     ;;
  451. + esac
  452. + case "$0" in
  453. + */*) cd `expr X$0 : 'X\(.*\)/'` ;;
  454. + esac
  455. + echo "Extracting agent/man/edusers.$manext (with variable substitutions)"
  456. + $rm -f edusers.$manext
  457. + $spitshell >edusers.$manext <<!GROK!THIS!
  458. + .TH PACKAGE $manext
  459. + ''' @(#) Manual page for mailagent's edusers command
  460. + '''
  461. + ''' $Id: edusers.SH,v 3.0.1.1 1994/09/22 13:53:06 ram Exp $
  462. + '''
  463. + '''  Copyright (c) 1990-1993, Raphael Manfredi
  464. + '''  
  465. + '''  You may redistribute only under the terms of the Artistic License,
  466. + '''  as specified in the README file that comes with the distribution.
  467. + '''  You may reuse parts of this distribution only within the terms of
  468. + '''  that same Artistic License; a copy of which may be found at the root
  469. + '''  of the source tree for mailagent 3.0.
  470. + '''
  471. + ''' $Log: edusers.SH,v $
  472. + ''' Revision 3.0.1.1  1994/09/22  13:53:06  ram
  473. + ''' patch12: created
  474. + '''
  475. + ''' 
  476. + .de Ex        \" Start of Example
  477. + .sp
  478. + .in +5
  479. + .nf
  480. + ..
  481. + .de Ef        \" End of Example
  482. + .sp
  483. + .in -5
  484. + .fi
  485. + ..
  486. + .SH NAME
  487. + edusers \- edit users list created by package
  488. + .SH SYNOPSIS
  489. + \fBedusers\fR [\fIsystem\fR [\fIversion\fR]]
  490. + .SH DESCRIPTION
  491. + This command lets you safely edit the \fIusers\fR list created by the
  492. + .I package
  493. + command. It locks the file before launching the editor, hence protecting
  494. + against any concurrent update by some \fIpackage\fR command that could
  495. + arrive at the same time (by e-mail). The level of protection this locking
  496. + buys you depends on the locking policy you have configured in
  497. + your \fI~/.mailagent\fR.
  498. + .PP
  499. + If you are within a package source tree, all you need to say is
  500. + .Ex
  501. + edusers
  502. + .Ef
  503. + to edit the \fIusers\fR file for that package. In order for that particular
  504. + feature to work properly, the package must have been placed under dist control,
  505. + or at least the \fIpackinit\fR command from the dist package must have been
  506. + run.
  507. + .PP
  508. + Otherwise, you may specify
  509. + a system name, and optionally a version number if that is not enough to
  510. + disambiguate. Using '-' will get you the lattest version available.
  511. + .PP
  512. + In any case, there must be a proper setting of the \fIdistribs\fR file
  513. + to use this command. If that file is not accurate, the \fIpackage\fR
  514. + command will not be able to produce a \fIusers\fR file anyway.
  515. + .SH ENVIRONMENT
  516. + The editor is taken out of the EDITOR variable if defined, then from
  517. + the VISUAL variable, defaulting to
  518. + .I $defeditor
  519. + if none of the variables is set.
  520. + .SH FILES
  521. + .PD 0
  522. + .TP 20
  523. + ~/.mailagent
  524. + configuration file for mailagent.
  525. + .TP
  526. + Spool/distribs
  527. + distribution list, same file as the one used for mailpatch.
  528. + .TP
  529. + System/.package
  530. + file created by dist's packinit command to indicate
  531. + the root of the source tree for that package.
  532. + .TP
  533. + System/users
  534. + list of users of that system.
  535. + .TP
  536. + Log/agentlog
  537. + mailagent's log file.
  538. + .PD
  539. + .SH AUTHOR
  540. + Raphael Manfredi <ram@acri.fr>
  541. + .SH "SEE ALSO"
  542. + mailagent($manext), metaconfig($manext), package($manext), packinit($manext).
  543. + !GROK!THIS!
  544. + chmod 444 edusers.$manext
  545.  
  546. Index: agent/magent.SH
  547. Prereq: 3.0.1.2
  548. *** agent/magent.SH.old    Thu Sep 22 16:42:54 1994
  549. --- agent/magent.SH    Thu Sep 22 16:42:54 1994
  550. ***************
  551. *** 24,30 ****
  552.   # via the filter. Mine looks like this:
  553.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  554.   
  555. ! # $Id: magent.SH,v 3.0.1.2 1994/07/01 14:54:29 ram Exp $
  556.   #
  557.   #  Copyright (c) 1990-1993, Raphael Manfredi
  558.   #  
  559. --- 24,30 ----
  560.   # via the filter. Mine looks like this:
  561.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  562.   
  563. ! # $Id: magent.SH,v 3.0.1.3 1994/09/22 13:52:34 ram Exp $
  564.   #
  565.   #  Copyright (c) 1990-1993, Raphael Manfredi
  566.   #  
  567. ***************
  568. *** 35,40 ****
  569. --- 35,48 ----
  570.   #  of the source tree for mailagent 3.0.
  571.   #
  572.   # $Log: magent.SH,v $
  573. + # Revision 3.0.1.3  1994/09/22  13:52:34  ram
  574. + # patch12: now performs &init_constants as soon as possible
  575. + # patch12: changed interface for &queue_mail to include first 2 letters
  576. + # patch12: context is loaded earlier to initialize callout queue
  577. + # patch12: added definition for $MAX_LINKS, $S_IWOTH, $S_IWGRP and &abs
  578. + # patch12: changed &email_addr to cache its result and not rely on $cf'user
  579. + # patch12: moved &init_signals to pl/signals.pl as &catch_signals
  580. + #
  581.   # Revision 3.0.1.2  1994/07/01  14:54:29  ram
  582.   # patch8: fixed leading From date format (spacing problem)
  583.   #
  584. ***************
  585. *** 193,198 ****
  586. --- 201,207 ----
  587.   
  588.   $file_name = shift;                # File name to be processed (null if stdin)
  589.   $ENV{'IFS'}='' if $ENV{'IFS'};    # Shell separation field
  590. + &init_constants;                # Constants definitions
  591.   &get_configuration;                # Get a suitable configuration package (cf)
  592.   select(STDOUT);                    # Because the -t option writes on STDOUT,
  593.   $| = 1;                            # make sure it is flushed before we fork()
  594. ***************
  595. *** 237,249 ****
  596.   
  597.   if (!$locked && !$nolock) {
  598.       # Another mailagent is running somewhere
  599. !     &queue_mail($file_name);
  600.       exit 0;
  601.   }
  602.   
  603.   # Initialize mail filtering and compile filter rule if necessary
  604.   &init_all;
  605.   &compile_rules unless $norule;
  606.   
  607.   # If rules are to be dumped, this is the only action
  608.   if ($dump_rule) {
  609. --- 246,259 ----
  610.   
  611.   if (!$locked && !$nolock) {
  612.       # Another mailagent is running somewhere
  613. !     &queue_mail($file_name, 'fm');
  614.       exit 0;
  615.   }
  616.   
  617.   # Initialize mail filtering and compile filter rule if necessary
  618.   &init_all;
  619.   &compile_rules unless $norule;
  620. + &context'init;        # Load context, initialize callout queue
  621.   
  622.   # If rules are to be dumped, this is the only action
  623.   if ($dump_rule) {
  624. ***************
  625. *** 286,292 ****
  626.       if (0 != &analyze_mail($file_name)) {    # Analyze the mail
  627.           &add_log("ERROR while processing main message--queing it")
  628.               if ($loglvl > 0);
  629. !         &queue_mail($file_name);
  630.           unlink $lockfile;
  631.           exit 0;                    # Do not continue
  632.       } else {
  633. --- 296,302 ----
  634.       if (0 != &analyze_mail($file_name)) {    # Analyze the mail
  635.           &add_log("ERROR while processing main message--queing it")
  636.               if ($loglvl > 0);
  637. !         &queue_mail($file_name, 'fm');
  638.           unlink $lockfile;
  639.           exit 0;                    # Do not continue
  640.       } else {
  641. ***************
  642. *** 364,371 ****
  643.   
  644.   # Start-up initializations
  645.   sub init_all {
  646. !     &init_signals;        # Trap common signals
  647. !     &init_constants;    # Constants definitions
  648.       &init_interpreter;    # Initialize tables %Priority, %Function, ...
  649.       &init_env;            # Initialize the %XENV array
  650.       &init_matcher;        # Initialize special matching functions
  651. --- 374,380 ----
  652.   
  653.   # Start-up initializations
  654.   sub init_all {
  655. !     &catch_signals;        # Trap common signals
  656.       &init_interpreter;    # Initialize tables %Priority, %Function, ...
  657.       &init_env;            # Initialize the %XENV array
  658.       &init_matcher;        # Initialize special matching functions
  659. ***************
  660. *** 375,394 ****
  661.       &init_special;        # Initialize special user table %Special
  662.   }
  663.   
  664. - # Protect ourselves (trap common signals)
  665. - sub init_signals {
  666. -     $SIG{'HUP'} = 'emergency';
  667. -     $SIG{'INT'} = 'emergency';
  668. -     $SIG{'QUIT'} = 'emergency';
  669. -     $SIG{'PIPE'} = 'emergency';
  670. -     $SIG{'IO'} = 'emergency';
  671. -     $SIG{'BUS'} = 'emergency';
  672. -     $SIG{'ILL'} = 'emergency';
  673. -     $SIG{'SEGV'} = 'emergency';
  674. -     $SIG{'ALRM'} = 'emergency';
  675. -     $SIG{'TERM'} = 'emergency';
  676. - }
  677. - 
  678.   # Constants definitions
  679.   sub init_constants {
  680.       require 'ctime.pl';
  681. --- 384,389 ----
  682. ***************
  683. *** 398,403 ****
  684. --- 393,402 ----
  685.       $LOCK_NB = 4;                # Make a non-blocking lock request
  686.       $LOCK_UN = 8;                # Unlock the file
  687.   
  688. +     # Stat constants for file rights
  689. +     $S_IWOTH = 02;                # Writable by world (no .ph files here)
  690. +     $S_IWGRP = 020;                # Writable by group
  691. + 
  692.       # Status used by filter
  693.       $FT_RESTART = 0;            # Abort current action, restart from scratch
  694.       $FT_CONT = 1;                # Continue execution
  695. ***************
  696. *** 432,437 ****
  697. --- 431,439 ----
  698.       $now =~ s/\s(\d:\d\d:\d\d)\b/0$1/;    # Add leading 0 if hour < 10
  699.       chop($now);
  700.       $FAKE_FROM = "From mailagent " . $now;
  701. + 
  702. +     # Miscellaneous constants
  703. +     $MAX_LINKS = 100;            # Maximum number of symbolic link levels
  704.   }
  705.   
  706.   # Initializes environment. All the variables are initialized in XENV array
  707. ***************
  708. *** 493,500 ****
  709.   }
  710.   
  711.   # Computes the e-mail address of the user
  712.   sub email_addr {
  713. !     $cf'user . '@' . &domain_addr;        # E-mail address in internet format
  714.   }
  715.   
  716.   # Domain name address for current host
  717. --- 495,510 ----
  718.   }
  719.   
  720.   # Computes the e-mail address of the user
  721. + # Can't rely on the value of $cf'user since config file may not have
  722. + # been parsed when this routine is first called.
  723.   sub email_addr {
  724. !     return $email_addr_cached if defined $email_addr_cached;
  725. !     local($user);
  726. !     ($user) = getpwuid($>);
  727. !     ($user) = getpwuid($<) unless $user;
  728. !     $user = 'nobody' unless $user;
  729. !     $email_addr_cached = $user . '@' . &domain_addr;
  730. !     return $email_addr_cached;    # E-mail address in internet format
  731.   }
  732.   
  733.   # Domain name address for current host
  734. ***************
  735. *** 517,522 ****
  736. --- 527,535 ----
  737.       $path;                                # Return possibly stripped path
  738.   }
  739.   
  740. + # Compute absolute value -- on one line to avoid dataloading
  741. + sub abs { $_[0] > 0 ? $_[0] : -$_[0]; }
  742. + 
  743.   # Compute the system mailbox file name
  744.   sub mailbox_name {
  745.       # If ~/.mailagent provides us with a mail directory, use it and possibly
  746. ***************
  747. *** 638,642 ****
  748. --- 651,657 ----
  749.   $grep -v '^;#' pl/tilde.pl >>magent
  750.   $grep -v '^;#' pl/mh.pl >>magent
  751.   $grep -v '^;#' pl/umask.pl >>magent
  752. + $grep -v '^;#' pl/signals.pl >>magent
  753. + $grep -v '^;#' pl/callout.pl >>magent
  754.   chmod 755 magent
  755.   $eunicefix magent
  756.  
  757. Index: agent/pl/secure.pl
  758. Prereq: 3.0
  759. *** agent/pl/secure.pl.old    Thu Sep 22 16:43:23 1994
  760. --- agent/pl/secure.pl    Thu Sep 22 16:43:23 1994
  761. ***************
  762. *** 1,4 ****
  763. ! ;# $Id: secure.pl,v 3.0 1993/11/29 13:49:16 ram Exp $
  764.   ;#
  765.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  766.   ;#  
  767. --- 1,4 ----
  768. ! ;# $Id: secure.pl,v 3.0.1.1 1994/09/22 14:38:04 ram Exp $
  769.   ;#
  770.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  771.   ;#  
  772. ***************
  773. *** 9,14 ****
  774. --- 9,17 ----
  775.   ;#  of the source tree for mailagent 3.0.
  776.   ;#
  777.   ;# $Log: secure.pl,v $
  778. + ;# Revision 3.0.1.1  1994/09/22  14:38:04  ram
  779. + ;# patch12: symbolic directories are now specially handled
  780. + ;#
  781.   ;# Revision 3.0  1993/11/29  13:49:16  ram
  782.   ;# Baseline for mailagent 3.0 netwide release.
  783.   ;#
  784. ***************
  785. *** 28,34 ****
  786.           return 0;        # Unsecure file
  787.       }
  788.       local($ST_MODE) = 2 + $[;    # Field st_mode from inode structure
  789. -     local($S_IWOTH) = 02;        # Writable by world (no .ph files here)
  790.       unless (-O _) {                # Reuse stat info from -e
  791.           &add_log("WARNING you do not own $type file $file") if $loglvl > 5;
  792.           return 0;        # Unsecure file
  793. --- 31,36 ----
  794. ***************
  795. *** 38,49 ****
  796.           &add_log("WARNING $type file is world writable!") if $loglvl > 5;
  797.           return 0;        # Unsecure file
  798.       }
  799.       return 1 unless $cf'secure =~ /on/i || $< == 0;
  800.   
  801.       # Extra checks for secure mode (or if root user). We make sure the
  802.       # file is not writable by group and then we conduct the same secure tests
  803.       # on the directory itself
  804. -     local($S_IWGRP) = 020;        # Writable by group
  805.       if ($st_mode & $S_IWGRP) {
  806.           &add_log("WARNING $type file is group writable!") if $loglvl > 5;
  807.           return 0;        # Unsecure file
  808. --- 40,51 ----
  809.           &add_log("WARNING $type file is world writable!") if $loglvl > 5;
  810.           return 0;        # Unsecure file
  811.       }
  812. + 
  813.       return 1 unless $cf'secure =~ /on/i || $< == 0;
  814.   
  815.       # Extra checks for secure mode (or if root user). We make sure the
  816.       # file is not writable by group and then we conduct the same secure tests
  817.       # on the directory itself
  818.       if ($st_mode & $S_IWGRP) {
  819.           &add_log("WARNING $type file is group writable!") if $loglvl > 5;
  820.           return 0;        # Unsecure file
  821. ***************
  822. *** 56,77 ****
  823.           return 0;        # Unsecure directory, therefore unsecure file
  824.       }
  825.       $st_mode = (stat(_))[$ST_MODE];
  826. !     if ($st_mode & $S_IWOTH) {
  827. !         &add_log("WARNING directory of $type file is world writable!")
  828.               if $loglvl > 5;
  829.           return 0;        # Unsecure directory
  830.       }
  831. !     if ($st_mode & $S_IWGRP) {
  832. !         &add_log("WARNING directory of $type file is group writable!")
  833.               if $loglvl > 5;
  834.           return 0;        # Unsecure directory
  835.       }
  836. !     if (-l $dir) {
  837. !         &add_log("WARNING directory of $type file $file is a symbolic link")
  838.               if $loglvl > 5;
  839.           return 0;        # Unsecure directory
  840.       }
  841. ! 
  842. !     1;        # At last! File is secure...
  843.   }
  844.   
  845. --- 58,145 ----
  846.           return 0;        # Unsecure directory, therefore unsecure file
  847.       }
  848.       $st_mode = (stat(_))[$ST_MODE];
  849. !     return 0 unless &check_st_mode($dir, 1);
  850. ! 
  851. !     # If linkdirs is OFF, we do not check further when faced with a symbolic
  852. !     # link to a directory.
  853. !     if (-l $dir && $cf'linkdirs !~ /^off/i && !&symdir_secure($dir, $type)) {
  854. !         &add_log("WARNING directory of $type file $file is an unsecure symlink")
  855.               if $loglvl > 5;
  856.           return 0;        # Unsecure directory
  857.       }
  858. ! 
  859. !     1;        # At last! File is secure...
  860. ! }
  861. ! 
  862. ! # Is a symbolic link to a directory secure?
  863. ! sub symdir_secure {
  864. !     local($dir, $type) = @_;
  865. !     if (&symdir_check($dir, 0)) {
  866. !         &add_log("symbolic directory $dir for $type file is secure")
  867. !             if $loglvl > 11;
  868. !         return 1;
  869. !     }
  870. !     0;    # Not secure
  871. ! }
  872. ! 
  873. ! # A symbolic directory (that is a symlink pointing to a directory) is secure
  874. ! # if and only if:
  875. ! #   - its target is a symlink that recursively proves to be secure.
  876. ! #   - the target lies in a non world-writable directory
  877. ! #   - the final directory at the end of the symlink chain is not world-writable
  878. ! #   - less than $MAX_LINKS levels of indirection are needed to reach a real dir
  879. ! # Unfortunately, we cannot check for group writability here for the parent
  880. ! # target directory since the target might lie in a system directory which may
  881. ! # have a legitimate need to be read/write for root and wheel, for instance.
  882. ! # The routine returns 1 if the file is secure, 0 otherwise.
  883. ! sub symdir_check {
  884. !     local($dir, $level) = @_;    # Directory, indirection level
  885. !     return 0 if $level++ > $MAX_LINKS;
  886. !     $dir = readlink($dir);
  887. !     unless (defined $dir) {
  888. !         &add_log("SYSERR readlink: $!") if $loglvl;
  889. !         return 0;
  890. !     }
  891. !     local($still_link) = -l _;
  892. !     unless (-d $dir || $still_link) {
  893. !         &add_log("ERROR inconsistency: $dir is a plain file?") if $loglvl;
  894. !         return 0;        # Reached a plain file while following links to a dir!
  895. !     }
  896. !     unless (-d "$dir/..") {
  897. !         &add_log("ERROR inconsistency: $dir/.. is not a directory?") if $loglvl;
  898. !         return 0;        # Reached a file hooked nowhere in the file system!
  899. !     }
  900. !     # Check parent directory
  901. !     local($ST_MODE) = 2 + $[;    # Field st_mode from inode structure
  902. !     $st_mode = (stat(_))[$ST_MODE];
  903. !     return 0 unless &check_st_mode("$dir/..", 0);
  904. !     # Recurse if still a symbolic link
  905. !     if ($still_link) {
  906. !         return 0 unless &symdir_check($dir, $level);
  907. !     } else {
  908. !         $st_mode = (stat($dir))[$ST_MODE];
  909. !         return 0 unless &check_st_mode($dir, 1);
  910. !     }
  911. !     1;    # Ok, link is secure
  912. ! }
  913. ! 
  914. ! # Returns true if mode in $st_mode does not include world or group writable
  915. ! # bits, false otherwise. This helps factorizing code used in both &file_secure
  916. ! # and &symdir_check. Set $both to true if both world/group checks are desirable,
  917. ! # false to get only world checks.
  918. ! sub check_st_mode {
  919. !     local($dir, $both) = @_;
  920. !     if ($st_mode & $S_IWOTH) {
  921. !         &add_log("WARNING directory of $type file $dir is world writable!")
  922.               if $loglvl > 5;
  923.           return 0;        # Unsecure directory
  924.       }
  925. !     return 1 unless $both;
  926. !     if ($st_mode & $S_IWGRP) {
  927. !         &add_log("WARNING directory of $type file $dir is group writable!")
  928.               if $loglvl > 5;
  929.           return 0;        # Unsecure directory
  930.       }
  931. !     1;
  932.   }
  933.   
  934.  
  935. Index: agent/pl/listqueue.pl
  936. Prereq: 3.0.1.1
  937. *** agent/pl/listqueue.pl.old    Thu Sep 22 16:43:14 1994
  938. --- agent/pl/listqueue.pl    Thu Sep 22 16:43:15 1994
  939. ***************
  940. *** 1,4 ****
  941. ! ;# $Id: listqueue.pl,v 3.0.1.1 1994/07/01 15:01:45 ram Exp $
  942.   ;#
  943.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  944.   ;#  
  945. --- 1,4 ----
  946. ! ;# $Id: listqueue.pl,v 3.0.1.2 1994/09/22 14:26:00 ram Exp $
  947.   ;#
  948.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  949.   ;#  
  950. ***************
  951. *** 9,14 ****
  952. --- 9,18 ----
  953.   ;#  of the source tree for mailagent 3.0.
  954.   ;#
  955.   ;# $Log: listqueue.pl,v $
  956. + ;# Revision 3.0.1.2  1994/09/22  14:26:00  ram
  957. + ;# patch12: localized variables used by stat() and localtime()
  958. + ;# patch12: now knows about callout queue messages
  959. + ;#
  960.   ;# Revision 3.0.1.1  1994/07/01  15:01:45  ram
  961.   ;# patch8: now honours new queuehold and queuelost config variables
  962.   ;#
  963. ***************
  964. *** 26,32 ****
  965.       }
  966.       local(@dir) = readdir DIR;        # Slurp the whole directory
  967.       closedir DIR;
  968. !     local(@files) = grep(s!^(q|f)m!$cf'queue/${1}m!, @dir);
  969.       undef @dir;
  970.       if (-f "$cf'queue/$agent_wait") {
  971.           if (open(WAITING, "$cf'queue/$agent_wait")) {
  972. --- 30,36 ----
  973.       }
  974.       local(@dir) = readdir DIR;        # Slurp the whole directory
  975.       closedir DIR;
  976. !     local(@files) = grep(s!^(q|f|c)m!$cf'queue/${1}m!, @dir);
  977.       undef @dir;
  978.       if (-f "$cf'queue/$agent_wait") {
  979.           if (open(WAITING, "$cf'queue/$agent_wait")) {
  980. ***************
  981. *** 78,83 ****
  982. --- 82,92 ----
  983.   .
  984.       local($n) = $#files + 1;
  985.       local($s) = $n > 1 ? 's' : '';
  986. +     local($_);
  987. +     local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  988. +         $atime,$mtime,$ctime,$blksize,$blocks);
  989. +     local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
  990. + 
  991.       print STDOUT "                   Mailagent Queue ($n request$s)\n";
  992.       foreach (@files) {
  993.           ($directory, $file) = m|^(.*)/(.*)|;
  994. ***************
  995. *** 110,121 ****
  996.           ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  997.               $atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
  998.           $status = '';
  999.           # If file has 'mbox.' as part of its name, then it is an emergency
  1000.           # saving done by the mailagent. If it starts with 'logname', then it
  1001.           # is an emergency saving done by the filter.
  1002.           $file =~ s/^mbox\.// && ($status = 'Backup');
  1003.           $file =~ s/^$cf'user\.// && ($status = 'Backup');
  1004. !         if ($file =~ /^qm/ && (time - $mtime) < $cf'queuehold) {
  1005.               # Queue mails starting with 'qm' have been queued by the filter
  1006.               # program. To avoid race conditions, those mails are skipped for
  1007.               # some time (cf to pqueue subroutine).
  1008. --- 119,144 ----
  1009.           ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  1010.               $atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
  1011.           $status = '';
  1012. + 
  1013.           # If file has 'mbox.' as part of its name, then it is an emergency
  1014.           # saving done by the mailagent. If it starts with 'logname', then it
  1015.           # is an emergency saving done by the filter.
  1016. + 
  1017.           $file =~ s/^mbox\.// && ($status = 'Backup');
  1018.           $file =~ s/^$cf'user\.// && ($status = 'Backup');
  1019. ! 
  1020. !         # Check for callout queue file. If it is a 'cm' file, or it is not in
  1021. !         # the queue and is recorded in the callout queue, then it is marked
  1022. !         # as a callout file and the queue time printed will be the trigger
  1023. !         # time.
  1024. ! 
  1025. !         if (
  1026. !             $file =~ /^cm/ ||
  1027. !             ($directory ne $cf'queue && &callout'trigger($_))
  1028. !         ) {
  1029. !             $mtime = &callout'trigger($_);    # May be called twice, that's ok.
  1030. !             $status = 'Callout';
  1031. !         } elsif ($file =~ /^qm/ && (time - $mtime) < $cf'queuehold) {
  1032.               # Queue mails starting with 'qm' have been queued by the filter
  1033.               # program. To avoid race conditions, those mails are skipped for
  1034.               # some time (cf to pqueue subroutine).
  1035. ***************
  1036. *** 124,136 ****
  1037.               # Processing of mail allowed (mailagent -q would flush it)
  1038.               $status = 'Deferred' unless $status;
  1039.           }
  1040.           ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  1041.               localtime($mtime);
  1042.           $queued = sprintf("%.2d/%.2d-%.2d:%.2d", ++$mon,$mday,$hour,$min);
  1043. !         $queued = 'Now' if (time - $mtime) < 60;
  1044.           $star = '';
  1045.           $star = '*' if $directory ne $cf'queue;    # Spot out-of-queue mails
  1046. !         if ((time - $mtime) > $cf'queuelost) {    # Also spot old mails
  1047.               $star = '#';
  1048.               $star = '@' if $directory ne $cf'queue;
  1049.           }
  1050. --- 147,165 ----
  1051.               # Processing of mail allowed (mailagent -q would flush it)
  1052.               $status = 'Deferred' unless $status;
  1053.           }
  1054. + 
  1055.           ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  1056.               localtime($mtime);
  1057.           $queued = sprintf("%.2d/%.2d-%.2d:%.2d", ++$mon,$mday,$hour,$min);
  1058. !         $queued = 'Now' if &'abs(time - $mtime) < 60;
  1059.           $star = '';
  1060.           $star = '*' if $directory ne $cf'queue;    # Spot out-of-queue mails
  1061. !         if ($status ne 'Callout') {
  1062. !             if ((time - $mtime) > $cf'queuelost) {    # Also spot old mails
  1063. !                 $star = '#';
  1064. !                 $star = '@' if $directory ne $cf'queue;
  1065. !             }
  1066. !         } elsif (time > $mtime) {    # Spot callouts that should have triggered
  1067.               $star = '#';
  1068.               $star = '@' if $directory ne $cf'queue;
  1069.           }
  1070.  
  1071. Index: agent/pl/context.pl
  1072. Prereq: 3.0
  1073. *** agent/pl/context.pl.old    Thu Sep 22 16:43:07 1994
  1074. --- agent/pl/context.pl    Thu Sep 22 16:43:08 1994
  1075. ***************
  1076. *** 1,4 ****
  1077. ! ;# $Id: context.pl,v 3.0 1993/11/29 13:48:38 ram Exp $
  1078.   ;#
  1079.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1080.   ;#  
  1081. --- 1,4 ----
  1082. ! ;# $Id: context.pl,v 3.0.1.1 1994/09/22 14:16:30 ram Exp $
  1083.   ;#
  1084.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1085.   ;#  
  1086. ***************
  1087. *** 9,14 ****
  1088. --- 9,19 ----
  1089.   ;#  of the source tree for mailagent 3.0.
  1090.   ;#
  1091.   ;# $Log: context.pl,v $
  1092. + ;# Revision 3.0.1.1  1994/09/22  14:16:30  ram
  1093. + ;# patch12: added access routines to detect context changes
  1094. + ;# patch12: context is now written back to disk only when changed
  1095. + ;# patch12: added callout queue knowledge
  1096. + ;#
  1097.   ;# Revision 3.0  1993/11/29  13:48:38  ram
  1098.   ;# Baseline for mailagent 3.0 netwide release.
  1099.   ;#
  1100. ***************
  1101. *** 25,32 ****
  1102.   # Initialize context from context file
  1103.   sub init {
  1104.       &default;                        # Load a default context
  1105. !     return unless -f $cf'context;    # Finished if no saved context
  1106. !     &load;                            # Load context, overwriting default context
  1107.       &clean;                            # Remove uneeded entries from context
  1108.   }
  1109.   
  1110. --- 30,37 ----
  1111.   # Initialize context from context file
  1112.   sub init {
  1113.       &default;                        # Load a default context
  1114. !     &load if -f $cf'context;        # Load context, overwriting default context
  1115. !     &callout'init;                    # Initialize callout queue
  1116.       &clean;                            # Remove uneeded entries from context
  1117.   }
  1118.   
  1119. ***************
  1120. *** 59,74 ****
  1121.   
  1122.   # Clean context, removing useless entries
  1123.   sub clean {
  1124. !     delete $Context{'last-clean'} unless $cf'autoclean =~ /^on/i;
  1125.   }
  1126.   
  1127. ! # Save a new context file
  1128.   sub save {
  1129.       require 'ctime.pl';
  1130.       local($existed) = -f $cf'context;
  1131.       &'acs_rqst($cf'context) if $existed;    # Lock existing file
  1132.       unless (open(CONTEXT, ">$cf'context")) {
  1133.           &'add_log("ERROR cannot overwrite context file: $!") if $'loglvl > 1;
  1134.           return;
  1135.       }
  1136.       &'add_log("saving context file $cf'context") if $'loglvl > 17;
  1137. --- 64,81 ----
  1138.   
  1139.   # Clean context, removing useless entries
  1140.   sub clean {
  1141. !     &delete('last-clean') if $cf'autoclean !~ /^on/i && &get('last-clean');
  1142.   }
  1143.   
  1144. ! # Save a new context file, if it has changed since we read it.
  1145.   sub save {
  1146. +     return unless $context_changed;         # Do not save if no change
  1147.       require 'ctime.pl';
  1148.       local($existed) = -f $cf'context;
  1149.       &'acs_rqst($cf'context) if $existed;    # Lock existing file
  1150.       unless (open(CONTEXT, ">$cf'context")) {
  1151.           &'add_log("ERROR cannot overwrite context file: $!") if $'loglvl > 1;
  1152. +         &'free_file($cf'context) if $existed;
  1153.           return;
  1154.       }
  1155.       &'add_log("saving context file $cf'context") if $'loglvl > 17;
  1156. ***************
  1157. *** 86,91 ****
  1158. --- 93,127 ----
  1159.   }
  1160.   
  1161.   #
  1162. + # Access features
  1163. + #
  1164. + 
  1165. + # Add or set an entry in the context
  1166. + sub set {
  1167. +     local($entry, $value) = @_;
  1168. +     $Context{$entry} = $value;
  1169. +     $context_changed++;
  1170. + }
  1171. + 
  1172. + # Get a context entry value
  1173. + sub get {
  1174. +     local($entry) = @_;
  1175. +     defined $Context{$entry} ? $Context{$entry} : undef;
  1176. + }
  1177. + 
  1178. + # Delete an entry from context
  1179. + sub delete {
  1180. +     local($entry) = @_;
  1181. +     unless (defined $Context{$entry}) {
  1182. +         &'add_log("WARNING attempting to delete inexistant $entry context")
  1183. +             if $'loglvl > 5;
  1184. +         return;
  1185. +     }
  1186. +     delete $Context{$entry};
  1187. +     $context_changed++;
  1188. + }
  1189. + 
  1190. + #
  1191.   # Context-dependant actions
  1192.   #
  1193.   
  1194. ***************
  1195. *** 96,107 ****
  1196.   sub autoclean {
  1197.       return unless $cf'autoclean =~ /^on/i;
  1198.       local($period) = &'seconds_in_period($cf'cleanlaps);
  1199. !     return if ($Context{'last-clean'} + $period) > time;
  1200.       # Retry time reached -- start auto cleaning
  1201.       &'add_log("autocleaning of dbr files") if $'loglvl > 8;
  1202.       $period = &'seconds_in_period($cf'agemax);
  1203.       &dbr'clean($period);
  1204. !     $Context{'last-clean'} = time;            # Update last cleaning time
  1205.   }
  1206.   
  1207.   #
  1208. --- 132,143 ----
  1209.   sub autoclean {
  1210.       return unless $cf'autoclean =~ /^on/i;
  1211.       local($period) = &'seconds_in_period($cf'cleanlaps);
  1212. !     return if (&get('last-clean') + $period) > time;
  1213.       # Retry time reached -- start auto cleaning
  1214.       &'add_log("autocleaning of dbr files") if $'loglvl > 8;
  1215.       $period = &'seconds_in_period($cf'agemax);
  1216.       &dbr'clean($period);
  1217. !     &set('last-clean', time);        # Update last cleaning time
  1218.   }
  1219.   
  1220.   #
  1221. ***************
  1222. *** 112,119 ****
  1223.   # the retry time was not reached. This routine is the main entry point in
  1224.   # the package, and is the only one called from the outside world.
  1225.   sub main'contextual_operations {
  1226. -     &init;                    # Initialize context
  1227.       &autoclean;                # Clean dbr hash files
  1228.       &save;                    # Save new context
  1229.   }
  1230.   
  1231. --- 148,155 ----
  1232.   # the retry time was not reached. This routine is the main entry point in
  1233.   # the package, and is the only one called from the outside world.
  1234.   sub main'contextual_operations {
  1235.       &autoclean;                # Clean dbr hash files
  1236. +     &callout'flush;            # Flush the callout queue
  1237.       &save;                    # Save new context
  1238.   }
  1239.   
  1240.  
  1241. Index: agent/filter/parser.c
  1242. Prereq: 3.0.1.2
  1243. *** agent/filter/parser.c.old    Thu Sep 22 16:42:53 1994
  1244. --- agent/filter/parser.c    Thu Sep 22 16:42:53 1994
  1245. ***************
  1246. *** 11,17 ****
  1247.   */
  1248.   
  1249.   /*
  1250. !  * $Id: parser.c,v 3.0.1.2 1994/07/01 14:53:57 ram Exp $
  1251.    *
  1252.    *  Copyright (c) 1990-1993, Raphael Manfredi
  1253.    *  
  1254. --- 11,17 ----
  1255.   */
  1256.   
  1257.   /*
  1258. !  * $Id: parser.c,v 3.0.1.3 1994/09/22 13:47:21 ram Exp $
  1259.    *
  1260.    *  Copyright (c) 1990-1993, Raphael Manfredi
  1261.    *  
  1262. ***************
  1263. *** 22,27 ****
  1264. --- 22,30 ----
  1265.    *  of the source tree for mailagent 3.0.
  1266.    *
  1267.    * $Log: parser.c,v $
  1268. +  * Revision 3.0.1.3  1994/09/22  13:47:21  ram
  1269. +  * patch12: extended security checks to mimic those done by mailagent
  1270. +  *
  1271.    * Revision 3.0.1.2  1994/07/01  14:53:57  ram
  1272.    * patch8: new routine get_confval to get integer config variables
  1273.    *
  1274. ***************
  1275. *** 52,57 ****
  1276. --- 55,67 ----
  1277.   #include <strings.h>
  1278.   #endif
  1279.   
  1280. + #ifdef I_SYS_PARAM
  1281. + #include <sys/param.h>
  1282. + #endif
  1283. + #ifndef MAX_PATHLEN
  1284. + #define MAX_PATHLEN        2048        /* Maximum path length allowed by kernel */
  1285. + #endif
  1286. + 
  1287.   #ifndef HAS_GETHOSTNAME
  1288.   #ifdef HAS_UNAME
  1289.   #include <sys/utsname.h>
  1290. ***************
  1291. *** 180,186 ****
  1292.        * Returning from this routine implies that the security checks succeeded.
  1293.        */
  1294.   
  1295. !     struct stat buf;        /* Statistics buffer */
  1296.   
  1297.       if (-1 == stat(file, &buf)) {
  1298.           add_log(1, "SYSERR stat: %m (%e)");
  1299. --- 190,196 ----
  1300.        * Returning from this routine implies that the security checks succeeded.
  1301.        */
  1302.   
  1303. !     struct stat buf;            /* Statistics buffer */
  1304.   
  1305.       if (-1 == stat(file, &buf)) {
  1306.           add_log(1, "SYSERR stat: %m (%e)");
  1307. ***************
  1308. *** 195,204 ****
  1309.   {
  1310.       /* Check basic permissions on the specified file. It cannot be world
  1311.        * writable and must be owned by the user. If the file specified does not
  1312. !      * exist, no error is reported however.
  1313.        */
  1314.   
  1315. !     struct stat buf;        /* Statistics buffer */
  1316.   
  1317.       if (-1 == stat(file, &buf))
  1318.           return;
  1319. --- 205,220 ----
  1320.   {
  1321.       /* Check basic permissions on the specified file. It cannot be world
  1322.        * writable and must be owned by the user. If the file specified does not
  1323. !      * exist, no error is reported however. If the 'secure' option is set
  1324. !      * to ON, or if we are running with superuser credentials, further checks
  1325. !      * are performed on the directory containing the file.
  1326.        */
  1327.   
  1328. !     struct stat buf;            /* Statistics buffer */
  1329. !     char parent[MAX_PATHLEN+1];    /* For parent directory */
  1330. !     char *cfsecure;                /* Config value for the 'secure' parameter */
  1331. !     char *c;                    /* Last slash position in file name */
  1332. !     int wants_secure = 0;        /* Set to true for extra security checks */
  1333.   
  1334.       if (-1 == stat(file, &buf))
  1335.           return;
  1336. ***************
  1337. *** 212,217 ****
  1338. --- 228,290 ----
  1339.   
  1340.       if (buf.st_uid != geteuid())
  1341.           fatal("file %s not owned by user!", file);
  1342. + 
  1343. +     cfsecure = ht_value(&symtab, "secure");    /* Do we need extra security? */
  1344. +     if (
  1345. +         (cfsecure != (char *) 0 &&            /* Ok, secure is defined */
  1346. +         0 == strcasecmp(cfsecure, "ON")) ||    /* And extra checks wanted */
  1347. +         geteuid() == ROOTID                    /* Running as superuser */
  1348. +     )
  1349. +         wants_secure = 1;                    /* Activate checks */
  1350. +             
  1351. +     if (!wants_secure) {
  1352. +         add_log(12, "basic checks ok for file %s", file);
  1353. +         return;
  1354. +     }
  1355. + 
  1356. +     /*
  1357. +      * Extra security checks for group writability and parent directory.
  1358. +      */
  1359. + 
  1360. +     add_log(17, "performing additional checks on %s", file);
  1361. + 
  1362. + #ifndef S_IWGRP
  1363. + #define S_IWGRP 00020        /* Write permissions for group */
  1364. + #endif
  1365. + 
  1366. +     if (buf.st_mode & S_IWGRP)
  1367. +         fatal("file %s is group writable!", file);
  1368. + 
  1369. +     /*
  1370. +      * Ok, go on and check the parent directory...
  1371. +      */
  1372. + 
  1373. +     if (*file != '/') {                /* Path is not abosule, assume from home */
  1374. +         strcpy(parent, home);        /* Prefill with home */
  1375. +         strcat(parent, "/");
  1376. +     } else
  1377. +         *parent = '\0';                /* Null string */
  1378. +     strcat(parent, file);            /* Append file to get an absolute path */
  1379. +     if (c = rindex(parent, '/'))
  1380. +         *c = '\0';                    /* Strip down last path component */
  1381. + 
  1382. +     add_log(17, "checking directory %s", parent);
  1383. + 
  1384. +     if (-1 == stat(parent, &buf)) {
  1385. +         add_log(1, "SYSERR stat: %m (%e)");
  1386. +         fatal("cannot stat directory %s", parent);
  1387. +     }
  1388. + 
  1389. +     if (buf.st_mode & S_IWOTH)
  1390. +         fatal("directory %s is world writable!", parent);
  1391. + 
  1392. +     if (buf.st_mode & S_IWGRP)
  1393. +         fatal("directory %s is group writable!", parent);
  1394. + 
  1395. +     if (buf.st_uid != geteuid())
  1396. +         fatal("directory %s not owned by user!", parent);
  1397. + 
  1398. +     add_log(12, "file %s seems to be secure", file);
  1399.   }
  1400.   
  1401.   public char *homedir()
  1402.  
  1403. Index: agent/pl/builtins.pl
  1404. Prereq: 3.0
  1405. *** agent/pl/builtins.pl.old    Thu Sep 22 16:43:06 1994
  1406. --- agent/pl/builtins.pl    Thu Sep 22 16:43:06 1994
  1407. ***************
  1408. *** 1,4 ****
  1409. ! ;# $Id: builtins.pl,v 3.0 1993/11/29 13:48:35 ram Exp $
  1410.   ;#
  1411.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1412.   ;#  
  1413. --- 1,4 ----
  1414. ! ;# $Id: builtins.pl,v 3.0.1.1 1994/09/22 14:10:40 ram Exp $
  1415.   ;#
  1416.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1417.   ;#  
  1418. ***************
  1419. *** 9,14 ****
  1420. --- 9,18 ----
  1421.   ;#  of the source tree for mailagent 3.0.
  1422.   ;#
  1423.   ;# $Log: builtins.pl,v $
  1424. + ;# Revision 3.0.1.1  1994/09/22  14:10:40  ram
  1425. + ;# patch12: added escapes in strings for perl5 support
  1426. + ;# patch12: builtins are now looked for in &run_builtins
  1427. + ;#
  1428.   ;# Revision 3.0  1993/11/29  13:48:35  ram
  1429.   ;# Baseline for mailagent 3.0 netwide release.
  1430.   ;#
  1431. ***************
  1432. *** 92,103 ****
  1433.   # The @RR command asks for a receipt
  1434.   sub builtin_rr {
  1435.       local($_) = @_;
  1436. !     &add_log("found an @RR request to $_") if $loglvl > 18;
  1437.       # @RR request honored only if not from special user and directed to us
  1438.       unless (&special_user) {
  1439.           push(@Builtcode, "&send_receipt('$_')");
  1440.       } else {
  1441. !         &add_log("ignoring @RR request to $_") if $loglvl > 4;
  1442.       }
  1443.   }
  1444.   
  1445. --- 96,107 ----
  1446.   # The @RR command asks for a receipt
  1447.   sub builtin_rr {
  1448.       local($_) = @_;
  1449. !     &add_log("found an \@RR request to $_") if $loglvl > 18;
  1450.       # @RR request honored only if not from special user and directed to us
  1451.       unless (&special_user) {
  1452.           push(@Builtcode, "&send_receipt('$_')");
  1453.       } else {
  1454. !         &add_log("ignoring \@RR request to $_") if $loglvl > 4;
  1455.       }
  1456.   }
  1457.   
  1458. ***************
  1459. *** 106,120 ****
  1460.       local($_) = @_;
  1461.       return if /[=\$^&*([{}`\\|;><?]/;        # Invalid character found
  1462.       $Userpath = $_;
  1463. !     &add_log("found an @PATH request to $_") if $loglvl > 18;
  1464.   }
  1465.   
  1466.   # Execute stacked builtins
  1467.   sub run_builtins {
  1468.       return if $#Builtcode < 0;        # No recorded builtins
  1469.       foreach (@Builtcode) {
  1470.           eval($_);                    # Execute stacked builtin
  1471.       }
  1472. !     @Builtcode = ();                # Reset builtcode array
  1473.   }
  1474.   
  1475. --- 110,136 ----
  1476.       local($_) = @_;
  1477.       return if /[=\$^&*([{}`\\|;><?]/;        # Invalid character found
  1478.       $Userpath = $_;
  1479. !     &add_log("found an \@PATH request to $_") if $loglvl > 18;
  1480.   }
  1481.   
  1482.   # Execute stacked builtins
  1483.   sub run_builtins {
  1484. +     undef @Builtcode;
  1485. +     # Lookup for builtins. Code moved out of &parse_mail.
  1486. +     foreach $line (split(/\n/, $Header{'Body'})) {
  1487. +         if ($line =~ s/^@(\w+)\s*//) {            # A builtin command ?
  1488. +             local($subroutine) = $Builtin{$1};
  1489. +             &$subroutine($line) if $subroutine;    # Record it if known
  1490. +         }
  1491. +     }
  1492. +     # End of original &parse_mail exerpt, beginning of original &run_builtins
  1493. +     # NOTE: since builtins are now looked for here and run from there directly,
  1494. +     # going through the burden of @Builtcode is not necessary. Will get fixed
  1495. +     # one day, possibly.
  1496.       return if $#Builtcode < 0;        # No recorded builtins
  1497.       foreach (@Builtcode) {
  1498.           eval($_);                    # Execute stacked builtin
  1499.       }
  1500. !     undef @Builtcode;                # Reset builtcode array
  1501.   }
  1502.   
  1503.  
  1504. *** End of Patch 14 ***
  1505.  
  1506. exit 0 # Just in case...
  1507.