git.marmaro.de Git - mmh/blob - docs/historical/mh-6.8.5/miscellany/audit/mh.pl

   1
   2
   3 # =====
   4 # Subroutine mh_profile
   5 #       Parse the user's .mh_profile and get arguments and settings
   6 #
   7 sub mh_profile {
   8     local($PROFILE);
   9
  10     ($PROFILE = $ENV{"MH"}) || ($PROFILE = $ENV{"HOME"} . "/.mh_profile");
  11
  12     open PROFILE || "$0: can't read mh_profile $PROFILE: $!\n";
  13
  14     while (<PROFILE>) {
  15         next if /^#/;
  16         next unless ($key, $value) = /([^:\s]+):\s*(.+)/;
  17         $key =~ tr/A-Z/a-z/;
  18         $MH{$key} = $value;
  19     }
  20     close PROFILE;
  21
  22     $MH{'path'} = $ENV{'HOME'} . '/' . $MH{'path'};
  23 }
  24
  25
  26 # =====
  27 # Subroutine rcvstore
  28 #       Convenience routine for MH users. Pipes incoming
  29 #       mail message to rcvstore. Expects one argument - the
  30 #       name of the folder to rcvstore into.
  31 #
  32 sub rcvstore {
  33     local($folder) = @_;
  34
  35     &openpipe("/usr/local/bin/mh/lib/rcvstore +$folder -create");
  36 }
  37
  38
  39 # =====
  40 # Subroutine rcvdist
  41 #       Convenience routine for MH users. Pipes incoming
  42 #       mail message to rcvdist. Expects one argument - the
  43 #       list of users to distribute the mail message to
  44 #
  45 sub rcvdist {
  46     local($recips) = @_;
  47
  48     &openpipe("/usr/local/bin/mh/lib/rcvdist $recips");
  49 }
  50
  51
  52 # =====
  53 # Subroutine rcvtty
  54 #       Convenience routine for MH users. Pipes incoming
  55 #       mail message to rcvtty. This is MH's version of biff.
  56 #
  57 sub rcvtty {
  58
  59     &openpipe("/usr/local/bin/mh/lib/rcvtty");
  60 }
  61
  62
  63 # =====
  64 # Subroutine ali
  65 #       Expand an MH alias into a list of names usable by
  66 #       rcvdist
  67 #
  68 sub ali {
  69     local($alias) = @_;
  70     local($recips);
  71     local(@list) = ();
  72
  73     $recips = `/usr/local/bin/mh/ali $alias`;
  74     chop $recips;
  75     return(@list) if ($alias eq $recips);
  76
  77     @list = split(/,/, $recips);
  78     return(@list);
  79 }
  80
  81
  82 # =====
  83 # Subroutine refile_from
  84 #       Refile a message into a folder by organization and
  85 #       sender name. The top-level folder is an argument
  86 #       the user can specify.
  87 #
  88 sub refile_from {
  89     local($toplevel) = @_;
  90
  91     return if (length($from) <= 0);
  92     return if ($from eq $user);
  93
  94     $toplevel = "log" if ($toplevel eq '');
  95     &rcvstore("$toplevel/$organization/$from");
  96 }
  97
  98 # =====
  99 # Subroutine make_mhpath
 100 #       Make a directory path recursively.
 101 #
 102 sub make_mhpath {
 103     local($dir) = @_;
 104     local($i);
 105     local($mode) = 0755;
 106
 107     $mode = oct($MH{'folder-protect'}) if (defined $MH{'folder-protect'});
 108
 109     $_ = $dir;
 110     s#^/.*#/# || s#^[^/].*#.#;
 111     $start = $_;
 112     foreach $i (split('/', $dir)) {
 113         $start = $start . '/' . $i;
 114         next if (-d $start);
 115         mkdir($start, $mode) || return(1);
 116     };
 117
 118     return(0);
 119 }
 120
 121
 122 # =====
 123 # Subroutine mh_parse
 124 #       Parse the command line options
 125 #
 126 sub mh_parse {
 127     local(@argdesc) =  @SW;
 128     local($wantarg);
 129
 130     while (($#ARGV >= 0) && ($ARGV[0] !~ /^-.+/)) { # must be a message list
 131         push(@MSGS, shift @ARGV);
 132     };
 133
 134     grep(s/(\W)/\\$1/g, @argdesc);
 135
 136     @ARGV = (split(' ', $MH{$program}), @ARGV) if defined($MH{$program});
 137
 138     return if ($#ARGV < 0);
 139
 140     while ($ARGV[0] =~ /^-.+/) {
 141
 142         $ARGV = shift @ARGV;
 143
 144         unless (@matches = grep(/$ARGV/, @argdesc)) {
 145             print "$program: unknown option: $ARGV\n";
 146             exit 1;
 147             &usage;
 148         }
 149
 150         for (@matches) { s/\\(\W)/$1/g; }
 151
 152         if ($#matches > $[) {
 153             print "$program: ambiguous switch $ARGV matches:\n";
 154             for (@matches) {
 155                 print "\    ", $_, "\n";
 156             }
 157             exit 1;
 158         }
 159
 160         ($switch,$wantarg) = $matches[$[] =~ /^-(\S+)\s*(\S*)/;
 161
 162         $SW{$switch} = $wantarg ? shift @ARGV : 1;
 163         if ($SW{$switch} =~ /^(['"]).*$/ && $SW{$switch} !~ /^(['"]).*\1$/) {
 164             do {
 165                 $SW{$switch} .= ' ' . (shift @ARGV);
 166             } until $#ARGV < 0 || $SW{$switch} =~ /^(['"]).*\1$/;
 167             $SW{$switch} =~ s/^(['"])(.*)\1$/$2/;
 168         }
 169     }
 170 }
 171
 172
 173 # =====
 174 # Subroutine print_switches
 175 #       print the valid command line switches
 176 #
 177 sub print_switches {
 178     local(@argdesc) = @SW;
 179
 180     print "   switches are:\n";
 181     for (sort @SW) {
 182         print "   $_\n";
 183     };
 184     print "\n";
 185 }
 186
 187
 188 1;