procmail/procmail-lib.pl

   1 # procmail-lib.pl
   2 # Functions for parsing the .procmailrc file
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 &init_config();
   7 %minfo = &get_module_info($module_name);
   8 if ($minfo{'usermin'}) {
   9         &switch_to_remote_user();
  10         &create_user_config_dirs();
  11         $procmailrc = "$remote_user_info[7]/.procmailrc";
  12         $includes = $userconfig{'includes'};
  13         }
  14 else {
  15         $procmailrc = $config{'procmailrc'};
  16         $includes = $config{'includes'};
  17         }
  18
  19 # get_procmailrc()
  20 # Parses the .procmailrc file into recipes
  21 sub get_procmailrc
  22 {
  23 return &parse_procmail_file($procmailrc);
  24 }
  25
  26 # parse_procmail_file(file)
  27 sub parse_procmail_file
  28 {
  29 local (@rv, $rec, $_);
  30 local $lnum = 0;
  31 local $fh = $_[0];
  32 open($fh, $_[0]);
  33 while(<$fh>) {
  34         local $slnum = $lnum;
  35         s/\s+$//;
  36         while(s/\\$//) {
  37                 local $cont = <$fh>;
  38                 $cont =~ s/\s+$//;
  39                 $cont =~ s/^\s+//;
  40                 $_ .= $cont;
  41                 $lnum++;
  42                 }
  43         while(/^\s*([^\s=]+)\s*=([^"]*)"([^"]*)$/) {
  44                 # Quote in environment variable that is not ended!
  45                 local $cont = <$fh>;
  46                 $cont =~ s/\r|\n//g;
  47                 $_ .= "\n".$cont;
  48                 $lnum++;
  49                 }
  50         if (!/^\*/) {
  51                 s/#.*$//;
  52                 s/\s+$//;
  53                 }
  54         if (/^\s*([^\s=]+)\s*=\s*"((.|\n)*)"$/ ||
  55             /^\s*([^\s=]+)\s*=\s*'((.|\n)*)'$/ ||
  56             /^\s*([^\s=]+)\s*=\s*((.|\n)*)$/) {
  57                 if ($1 eq "INCLUDERC") {
  58                         local $ifile = $2;
  59                         if ($includes && $ifile !~ /\$/) {
  60                                 # Including another file
  61                                 local @inc = &parse_procmail_file(
  62                                         &make_absolute($ifile, $procmailrc));
  63                                 map { $_->{'index'} += scalar(@rv) } @inc;
  64                                 push(@rv, @inc);
  65                                 }
  66                         else {
  67                                 # Just indicate the include
  68                                 local $inc = { 'index' => scalar(@rv),
  69                                                'file' => $_[0],
  70                                                'line' => $slnum,
  71                                                'eline' => $lnum,
  72                                                'include' => $ifile };
  73                                 push(@rv, $inc);
  74                                 }
  75                         }
  76                 elsif ($1 eq "SWITCHRC") {
  77                         # Change to another file
  78                         local @inc = &parse_procmail_file(
  79                                         &make_absolute("$2", $procmailrc));
  80                         map { $_->{'index'} += scalar(@rv) } @inc;
  81                         push(@rv, @inc);
  82                         last;
  83                         }
  84                 elsif ($rec) {
  85                         # Environment variable as action for recipe
  86                         $rec->{'type'} = "=";
  87                         $rec->{'action'} = "$1=$2";
  88                         $rec->{'eline'} = $lnum;
  89                         $rec = undef;
  90                         }
  91                 else {
  92                         # Environment variable assignment
  93                         local $env = { 'index' => scalar(@rv),
  94                                        'file' => $_[0],
  95                                        'line' => $slnum,
  96                                        'eline' => $lnum,
  97                                        'name' => $1,
  98                                        'value' => $2 };
  99                         push(@rv, $env);
 100                         }
 101                 }
 102         elsif (/^\s*:0\s*(\S*)\s*:\s*(.*)$/ || /^:0\s*(\S*)/) {
 103                 # Start of a new recipe
 104                 $rec = { 'index' => scalar(@rv),
 105                          'file' => $_[0],
 106                          'line' => $slnum,
 107                          'eline' => $lnum,
 108                          'lockfile' => $2,
 109                          'flags' => [ split(//, $1) ] };
 110                 push(@rv, $rec);
 111                 }
 112         elsif (/^\s*\*\s*(\!|\$|\?|<|>|)(.*)$/) {
 113                 # A condition for a recipe
 114                 push(@{$rec->{'conds'}}, [ $1, $2 ]);
 115                 $rec->{'eline'} = $lnum;
 116                 }
 117         elsif (/^\s*\{\s*$/) {
 118                 # A conditional action .. read till the end
 119                 local $nest = 1;
 120                 $rec->{'block'} = "";
 121                 while(<$fh>) {
 122                         $lnum++;
 123                         if (/^\{\s*$/) {
 124                                 $nest++;
 125                                 }
 126                         elsif (/^\}\s*$/) {
 127                                 last if (!--$nest);
 128                                 }
 129                         $rec->{'block'} .= $_;
 130                         }
 131                 $rec->{'eline'} = $lnum;
 132                 $rec = undef;
 133                 }
 134         elsif (/^\s*\{(.*)\}\s*$/) {
 135                 # A single-line conditional action ..
 136                 $rec->{'block'} = $1;
 137                 $rec->{'eline'} = $lnum;
 138                 $rec = undef;
 139                 }
 140         elsif (/^\s*(\!|\|)\s*(.*)$/) {
 141                 # The action for a recipe
 142                 $rec->{'type'} = $1;
 143                 $rec->{'action'} = $2;
 144                 $rec->{'eline'} = $lnum;
 145                 $rec = undef;
 146                 }
 147         elsif (/\S/) {
 148                 if ($rec->{'action'}) {
 149                         # Unknown line
 150                         &error(&text('config_eline', $slnum+1,
 151                                      $_[0], "<tt>$_</tt>"));
 152                         }
 153                 else {
 154                         # File delivery action
 155                         $rec->{'type'} = undef;
 156                         $rec->{'action'} = $_;
 157                         $rec->{'eline'} = $lnum;
 158                         if ($rec->{'action'} =~ /^\"(.*)\"$/) {
 159                                 # Quoted path .. un-quote
 160                                 $rec->{'action'} = $1;
 161                                 }
 162                         $rec = undef;
 163                         }
 164                 }
 165         $lnum++;
 166         }
 167 close($fh);
 168 return @rv;
 169 }
 170
 171 # create_recipe(&recipe, [file])
 172 sub create_recipe
 173 {
 174 local $lref = &read_file_lines($_[1] || $procmailrc);
 175 push(@$lref, &recipe_lines($_[0]));
 176 &flush_file_lines();
 177 }
 178
 179 # create_recipe_before(&recipe, &before, [file])
 180 sub create_recipe_before
 181 {
 182 local $lref = &read_file_lines($_[2] || $procmailrc);
 183 local @lines = &recipe_lines($_[0]);
 184 splice(@$lref, $_[1]->{'line'}, 0, @lines);
 185 $_[1]->{'line'} += @lines;
 186 $_[1]->{'eline'} += @lines;
 187 &flush_file_lines();
 188 }
 189
 190 # delete_recipe(&recipe)
 191 sub delete_recipe
 192 {
 193 local $lref = &read_file_lines($_[0]->{'file'});
 194 splice(@$lref, $_[0]->{'line'}, $_[0]->{'eline'} - $_[0]->{'line'} + 1);
 195 &flush_file_lines();
 196 }
 197
 198 # modify_recipe(&recipe)
 199 sub modify_recipe
 200 {
 201 local $lref = &read_file_lines($_[0]->{'file'});
 202 splice(@$lref, $_[0]->{'line'}, $_[0]->{'eline'} - $_[0]->{'line'} + 1,
 203        &recipe_lines($_[0]));
 204 &flush_file_lines();
 205 }
 206
 207 # swap_recipes(&recipe1, &recipe2)
 208 sub swap_recipes
 209 {
 210 local $lref0 = &read_file_lines($_[0]->{'file'});
 211 local $lref1 = &read_file_lines($_[1]->{'file'});
 212 local @lines0 = @$lref0[$_[0]->{'line'} .. $_[0]->{'eline'}];
 213 local @lines1 = @$lref1[$_[1]->{'line'} .. $_[1]->{'eline'}];
 214 if ($_[0]->{'line'} < $_[1]->{'line'}) {
 215         splice(@$lref1, $_[1]->{'line'}, $_[1]->{'eline'} - $_[1]->{'line'} + 1,
 216                @lines0);
 217         splice(@$lref0, $_[0]->{'line'}, $_[0]->{'eline'} - $_[0]->{'line'} + 1,
 218                @lines1);
 219         }
 220 else {
 221         splice(@$lref0, $_[0]->{'line'}, $_[0]->{'eline'} - $_[0]->{'line'} + 1,
 222                @lines1);
 223         splice(@$lref1, $_[1]->{'line'}, $_[1]->{'eline'} - $_[1]->{'line'} + 1,
 224                @lines0);
 225         }
 226 &flush_file_lines();
 227 }
 228
 229 sub recipe_lines
 230 {
 231 if ($_[0]->{'name'}) {
 232         # Environment variable
 233         local $v = $_[0]->{'value'} =~ /\n/ ? $_[0]->{'value'} :
 234                    $_[0]->{'value'} =~ /^\`/ ? $_[0]->{'value'} :
 235                    $_[0]->{'value'} =~ /^\S+$/ ? $_[0]->{'value'} :
 236                    $_[0]->{'value'} =~ /"/ ? "'$_[0]->{'value'}'" :
 237                                             "\"$_[0]->{'value'}\"";
 238         return ( $_[0]->{'name'}."=".$v );
 239         }
 240 elsif ($_[0]->{'include'}) {
 241         # Included file
 242         local $v = $_[0]->{'include'} =~ /^\`/ ? $_[0]->{'include'} :
 243                    $_[0]->{'include'} =~ /^\S+$/ ? $_[0]->{'include'} :
 244                    $_[0]->{'include'} =~ /"/ ? "'$_[0]->{'include'}'" :
 245                                             "\"$_[0]->{'include'}\"";
 246         return ( "INCLUDERC=".$v );
 247         }
 248 else {
 249         # Recipe with conditions and action
 250         local (@rv, $c);
 251         push(@rv, ":0".join("", @{$_[0]->{'flags'}}));
 252         if (defined($_[0]->{'lockfile'})) {
 253                 $rv[0] .= ":".$_[0]->{'lockfile'};
 254                 }
 255         foreach $c (@{$_[0]->{'conds'}}) {
 256                 push(@rv, "* ".$c->[0].$c->[1]);
 257                 }
 258         if (defined($_[0]->{'block'})) {
 259                 push(@rv, "{", split(/\n/, $_[0]->{'block'}), "}");
 260                 }
 261         elsif ($_[0]->{'type'} && $_[0]->{'type'} ne '=') {
 262                 push(@rv, $_[0]->{'type'}." ".$_[0]->{'action'});
 263                 }
 264         elsif ($_[0]->{'action'} =~ /^(\S+)=/) {
 265                 # Variable assignment .. don't quote
 266                 push(@rv, $_[0]->{'action'});
 267                 }
 268         elsif ($_[0]->{'action'} !~ /^\S+$/) {
 269                 # File with a space .. need to quote
 270                 push(@rv, "\"$_[0]->{'action'}\"");
 271                 }
 272         else {
 273                 # File delivery
 274                 push(@rv, $_[0]->{'action'});
 275                 }
 276         return @rv;
 277         }
 278 }
 279
 280 # parse_action(&recipe)
 281 sub parse_action
 282 {
 283 if ($_[0]->{'type'} eq '|') {
 284         return (4, $_[0]->{'action'});
 285         }
 286 elsif ($_[0]->{'type'} eq '!') {
 287         return (3, $_[0]->{'action'});
 288         }
 289 elsif ($_[0]->{'type'} eq '=') {
 290         local ($n, $v) = split(/=/, $_[0]->{'action'}, 2);
 291         return (6, $n);
 292         }
 293 elsif (defined($_[0]->{'block'})) {
 294         return (5);
 295         }
 296 elsif ($_[0]->{'action'} =~ /^(.*)\/$/) {
 297         return (2, $1);
 298         }
 299 elsif ($_[0]->{'action'} =~ /^(.*)\/\.$/) {
 300         return (1, $1);
 301         }
 302 else {
 303         return (0, $_[0]->{'action'});
 304         }
 305 }
 306
 307 # make_absolute(file, basefile)
 308 sub make_absolute
 309 {
 310 return $_[0] if ($_[0] =~ /^\//);
 311 $_[1] =~ /^(.*)\/[^\/]+$/;
 312 return "$1/$_[0]";
 313 }
 314
 315 # check_mailserver_config()
 316 # Works out which mail server appears to be installed, and returns the
 317 # module name and possibly an error message if Procmail is not setup
 318 sub check_mailserver_config
 319 {
 320 # Find a running mail server
 321 local $ms = &foreign_installed("qmailadmin") &&
 322              &qmailadmin::is_qmail_running() ? "qmailadmin" :
 323             &foreign_installed("postfix") &&
 324              &postfix::is_postfix_running() ? "postfix" :
 325             &foreign_installed("sendmail") &&
 326              &sendmail::is_sendmail_running() ? "sendmail" : undef;
 327 # Fall back to installed mail server
 328 local $ms = &foreign_installed("qmailadmin") ? "qmailadmin" :
 329             &foreign_installed("postfix") ? "postfix" :
 330             &foreign_installed("sendmail") ? "sendmail" : undef;
 331 return () if (!$ms);
 332 local $err;
 333 local $procmail_cmd = &has_command($config{'procmail'});
 334 if ($ms eq "qmailadmin") {
 335         # Don't know how to check for this
 336         $err = undef;
 337         }
 338 elsif ($ms eq "postfix") {
 339         # Check mailbox_command
 340         &foreign_require("postfix", "postfix-lib.pl");
 341         local $cmd = &postfix::get_real_value("mailbox_command");
 342         if ($cmd !~ /procmail/) {
 343                 $err = &text('check_epostfix', "mailbox_command",
 344                              $postfix::config{'postfix_config_file'},
 345                              $procmail_cmd);
 346                 }
 347         }
 348 elsif ($ms eq "sendmail") {
 349         # Check for local or procmail mailer
 350         &foreign_require("sendmail", "sendmail-lib.pl");
 351         local $conf = &sendmail::get_sendmailcf();
 352         local $found;
 353         foreach my $c (@$conf) {
 354                 if ($c->{'type'} eq 'M' && $c->{'value'} =~ /procmail/) {
 355                         $found++;
 356                         last;
 357                         }
 358                 }
 359         if (!$found) {
 360                 $err = &text('check_esendmail','../sendmail/list_features.cgi');
 361                 }
 362         }
 363 return ($ms, $err);
 364 }
 365
 366 @known_flags = ('H', 'B', 'D', 'h', 'b', 'c', 'w', 'W', 'i', 'r', 'f');
 367
 368 1;
 369