majordomo/majordomo-lib.pl

   1 # majordomo-lib.pl
   2 # Common majordomo functions
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 &init_config();
   7
   8 %MAJOR_ENV = ( 'HOME', $config{'program_dir'} );
   9
  10 # get_config()
  11 # Parse and return the majordomo config file
  12 sub get_config
  13 {
  14 local(@rv, $line);
  15 open(CONF, $config{'majordomo_cf'});
  16 while(<CONF>) {
  17         s/\r|\n//g;
  18         if (/^\s*\$(\S+)\s*=\s*"(.*)";\s*$/ ||
  19             /^\s*\$(\S+)\s*=\s*'(.*)';\s*$/) {
  20                 # static config option
  21                 push(@rv, { 'name' => $1,
  22                             'value' => &perl_unescape($2),
  23                             'line' => $line,
  24                             'eline' => $line });
  25                 }
  26         elsif (/^\s*\$(\S+)\s*=\s*<<\s*'(\S+)';\s*$/) {
  27                 # multiline config option
  28                 local $o = { 'name' => $1,
  29                              'line' => $2 };
  30                 local $end = $3;
  31                 while(<CONF>) {
  32                         $line++;
  33                         last if ($_ =~ /^$end[\r\n]+$/);
  34                         $o->{'value'} .= $_;
  35                         }
  36                 $o->{'eline'} = $line;
  37                 push(@rv, $o);
  38                 }
  39 #       elsif (/^\s*\$(\S+)\s*=\s*\$ENV\{['"]([^'"]+)['"]\};\s*$/) {
  40 #               # from majordomo environment variable
  41 #               push(@rv, { 'name' => $1,
  42 #                           'value' => $MAJOR_ENV{$2},
  43 #                           'line' => $line,
  44 #                           'eline' => $line });
  45 #               }
  46         elsif (/^\s*\$(\S+)\s*=\s*(.*);\s*$/) {
  47                 # computed config option
  48                 push(@rv, { 'name' => $1,
  49                             'value' => $2,
  50                             'computed' => 1,
  51                             'line' => $line,
  52                             'eline' => $line });
  53                 }
  54         $line++;
  55         }
  56 close(CONF);
  57 return \@rv;
  58 }
  59
  60 # save_directive(&config, name, value)
  61 # Update some directive in the global config file
  62 sub save_directive
  63 {
  64 local $old = &find($_[1], $_[0]);
  65 return if (!$old);
  66 local $lref = &read_file_lines($config{'majordomo_cf'});
  67 local $olen = $old->{'eline'} - $old->{'line'} + 1;
  68 local $v = $_[2];
  69 $v =~ s/\n$//;
  70 if ($v =~ /\n/) {
  71         splice(@$lref, $old->{'line'}, $olen,
  72                ( "\$$_[1] = <<'END';", split(/\n/, $v, -1), "END" ));
  73         }
  74 else {
  75         $v =~ s/\@/\\@/g;
  76         splice(@$lref, $old->{'line'}, $olen, "\$$_[1] = \"$v\";");
  77         }
  78 }
  79
  80 # find(name, &array)
  81 sub find
  82 {
  83 local($c, @rv);
  84 foreach $c (@{$_[1]}) {
  85         if ($c->{'name'} eq $_[0]) {
  86                 push(@rv, $c);
  87                 }
  88         }
  89 return @rv ? wantarray ? @rv : $rv[0]
  90            : wantarray ? () : undef;
  91 }
  92
  93 # find_value(name, &array)
  94 sub find_value
  95 {
  96 local(@v);
  97 @v = &find($_[0], $_[1]);
  98 @v = grep { !$_->{'computed'} } @v;
  99 if (!@v) { return undef; }
 100 elsif (wantarray) { return map { $_->{'value'} } @v; }
 101 else { return $v[0]->{'value'}; }
 102 }
 103
 104 # list_lists(&config)
 105 # Returns a list of mailing list names
 106 sub list_lists
 107 {
 108 local ($l, @rv);
 109 local $ldir = &perl_var_replace(&find_value("listdir", $_[0]), $_[0]);
 110 opendir(DIR, $ldir);
 111 while($l = readdir(DIR)) {
 112         if ($l =~ /^(\S+)\.config$/ && $1 !~ /\.old$/) {
 113                 push(@rv, $1);
 114                 }
 115         }
 116 closedir(DIR);
 117 return @rv;
 118 }
 119
 120 # get_list(name, &config)
 121 # Returns the details of some list
 122 sub get_list
 123 {
 124 local $ldir = &perl_var_replace(&find_value("listdir", $_[1]), $_[1]);
 125 local %list;
 126 return undef if (!-r "$ldir/$_[0].config");
 127 $list{'name'} = $_[0];
 128 $list{'members'} = "$ldir/$_[0]";
 129 $list{'config'} = "$ldir/$_[0].config";
 130 $list{'info'} = "$ldir/$_[0].info";
 131 $list{'intro'} = "$ldir/$_[0].intro";
 132 return \%list;
 133 }
 134
 135 # get_list_config(file)
 136 sub get_list_config
 137 {
 138 local(@rv, $line);
 139 $lnum = 0;
 140 open(CONF, $_[0]);
 141 while(<CONF>) {
 142         s/\r|\n//g;
 143         s/#.*$//g;
 144         if (/^\s*(\S+)\s*=\s*(.*)$/) {
 145                 # single value
 146                 push(@rv, { 'name' => $1,
 147                             'value' => $2,
 148                             'index' => scalar(@rv),
 149                             'line' => $lnum,
 150                             'eline' => $lnum });
 151                 }
 152         elsif (/^\s*(\S+)\s*<<\s*(\S+)/) {
 153                 # multi-line value
 154                 local $c = { 'name' => $1,
 155                              'index' => scalar(@rv),
 156                              'line' => $lnum };
 157                 local $end = $2;
 158                 while(<CONF>) {
 159                         $lnum++;
 160                         last if (/^$end[\r\n]+$/);
 161                         s/^--/-/;
 162                         s/^-\n/\n/;
 163                         $c->{'value'} .= $_;
 164                         }
 165                 $c->{'eline'} = $lnum;
 166                 push(@rv, $c);
 167                 }
 168         $lnum++;
 169         }
 170 return \@rv;
 171 }
 172
 173 # save_list_directive(&config, file, name, value, multiline)
 174 sub save_list_directive
 175 {
 176 local $old = &find($_[2], $_[0]);
 177 local $lref = &read_file_lines($_[1]);
 178 local ($pos, $olen, $nlen);
 179 if ($old) {
 180         $olen = $old->{'eline'} - $old->{'line'} + 1;
 181         $pos = $old->{'line'};
 182         }
 183 else {
 184         $olen = 0;
 185         $pos = @$lref;
 186         }
 187 if ($_[4]) {
 188         local $ov = $old->{'value'};
 189         $ov =~ s/\n$//;
 190         local $v = $_[3];
 191         $v =~ s/\n$//;
 192         local @lines = split(/\n/, $v, -1);
 193         @lines = map { s/^-/--/; s/^$/-/; $_ } @lines;
 194         splice(@$lref, $pos, $olen, ("$_[2]        <<   END", @lines, "END"))
 195                 if (!$old || $v ne $ov);
 196         $nlen = (!$old || $v ne $ov) ? @lines + 2 : $olen;
 197         }
 198 else {
 199         splice(@$lref, $pos, $olen, "$_[2] = $_[3]")
 200                 if (!$old || $_[3] ne $old->{'value'});
 201         $nlen = 1;
 202         }
 203 if ($old && $nlen != $olen) {
 204         foreach $c (@{$_[0]}) {
 205                 if ($c->{'line'} > $old->{'eline'}) {
 206                         $c->{'line'} += ($nlen - $olen);
 207                         $c->{'eline'} += ($nlen - $olen);
 208                         }
 209                 }
 210         }
 211 }
 212
 213 # get_aliases_file()
 214 # Returns the paths to the sendmail-style aliases files
 215 sub get_aliases_file
 216 {
 217 if ($config{'aliases_file'} eq 'postfix') {
 218         # Get from Postfix config
 219         &foreign_require("postfix", "postfix-lib.pl");
 220         local @afiles = &postfix::get_aliases_files(
 221                                 &postfix::get_current_value("alias_maps"));
 222         $aliases_module = "postfix";
 223         return \@afiles;
 224         }
 225 else {
 226         &foreign_require("sendmail", "sendmail-lib.pl");
 227         &foreign_require("sendmail", "aliases-lib.pl");
 228         $aliases_module = "sendmail";
 229         if ($config{'aliases_file'} eq '') {
 230                 # Get from Sendmail
 231                 local $sm_conf = &sendmail::get_sendmailcf();
 232                 return &sendmail::aliases_file($sm_conf);
 233                 }
 234         else {
 235                 # Use fixed file
 236                 return [ $config{'aliases_file'} ];
 237                 }
 238         }
 239 }
 240
 241 # perl_unescape(string)
 242 # Converts a string like "hello\@there\\foo" to "hello@there\foo"
 243 sub perl_unescape
 244 {
 245 local $v = $_[0];
 246 $v =~ s/\\(.)/$1/g;
 247 return $v;
 248 }
 249
 250 # perl_var_replace(string, &config)
 251 # Replaces variables like $foo in a string with their value from
 252 # the config file
 253 sub perl_var_replace
 254 {
 255 local $str = $_[0];
 256 local %donevar;
 257 while($str =~ /\$([A-z0-9\_]+)/ && !$donevar{$1}) {
 258         $donevar{$1}++;
 259         local $val = &find_value($1, $_[1]);
 260         $str =~ s/\$([A-z0-9\_]+)/$val/;
 261         }
 262 return $str;
 263 }
 264
 265 # set_permissions(file)
 266 # Sets the ownership and permissions on some file or directory,
 267 # based on the ownership of the lists directory
 268 sub set_permissions
 269 {
 270 local $conf = &get_config();
 271 local $ldir = &perl_var_replace(&find_value("listdir", $conf), $conf);
 272 local @ldir = stat($ldir);
 273 chown($ldir[4], $ldir[5], $_[0]);
 274 if ($config{'perms'}) {
 275         chmod(-d $_[0] ? 0755 : 0644, $_[0]);
 276         }
 277 else {
 278         chmod(-d $_[0] ? 0775 : 0664, $_[0]);
 279         }
 280 }
 281
 282 # choice_input(name, text, &config, [opt, display]+)
 283 sub choice_input
 284 {
 285 local $v = &find_value($_[0], $_[2]);
 286 local $rv = "<td><b>$_[1]</b></td> <td nowrap>";
 287 for($i=3; $i<@_; $i+=2) {
 288         local $ch = $v eq $_[$i] ? "checked" : "";
 289         $rv .= "<input name=$_[0] type=radio value='$_[$i]' $ch> ".$_[$i+1];
 290         }
 291 $rv .= "</td>\n";
 292 return $rv;
 293 }
 294
 295 # save_choice(&config, file, name)
 296 sub save_choice
 297 {
 298 &save_list_directive($_[0], $_[1], $_[2], $in{$_[2]});
 299 }
 300
 301 # opt_input(name, text, &config, default, size, [units])
 302 sub opt_input
 303 {
 304 local $v = &find_value($_[0], $_[2]);
 305 local $rv = "<td><b>$_[1]</b></td> <td nowrap ".
 306             ($_[4] > 30 ? "colspan=3" : "").">";
 307 $rv .= sprintf "<input type=radio name=$_[0]_def value=1 %s> $_[3]\n",
 308                 $v eq "" ? "checked" : "";
 309 $rv .= sprintf "<input type=radio name=$_[0]_def value=0 %s>\n",
 310                 $v eq "" ? "" : "checked";
 311 local $passwd = $_[0] =~ /passwd/ ? "type=password" : "";
 312 $rv .= "<input $passwd name=$_[0] size=$_[4] value=\"$v\"> $_[5]</td>\n";
 313 return $rv;
 314 }
 315
 316 # save_opt(&config, file, name, [&func])
 317 sub save_opt
 318 {
 319 if ($in{"$_[2]_def"}) { &save_list_directive($_[0], $_[1], $_[2], ""); }
 320 elsif ($_[3] && ($err = &{$_[3]}($in{$_[2]}))) { &error($err); }
 321 else { &save_list_directive($_[0], $_[1], $_[2], $in{$_[2]}); }
 322 }
 323
 324 # select_input(name, text, &config, [opt, display]+)
 325 sub select_input
 326 {
 327 local $v = &find_value($_[0], $_[2]);
 328 local $rv = "<td><b>$_[1]</b></td> <td nowrap><select name=$_[0]>";
 329 for($i=3; $i<@_; $i+=2) {
 330         local $ch = $v eq $_[$i] ? "selected" : "";
 331         $rv .= "<option value='$_[$i]' $ch> ".$_[$i+1];
 332         }
 333 $rv .= "</select></td>\n";
 334 return $rv;
 335 }
 336
 337 # save_select(&config, file, name)
 338 sub save_select
 339 {
 340 &save_list_directive($_[0], $_[1], $_[2], $in{$_[2]});
 341 }
 342
 343 # multi_input(name, text, &config)
 344 sub multi_input
 345 {
 346 local $v = &find_value($_[0], $_[2]);
 347 local $rv = "<td valign=top><b>$_[1]</b></td> <td colspan=3>".
 348             "<textarea rows=4 cols=80 name=$_[0]>\n$v</textarea></td>\n";
 349 return $rv;
 350 }
 351
 352 # save_multi(&config, file, name)
 353 sub save_multi
 354 {
 355 $in{$_[2]} =~ s/\r//g;
 356 &save_list_directive($_[0], $_[1], $_[2], $in{$_[2]}, 1);
 357 }
 358
 359 # can_edit_list(&access, name)
 360 sub can_edit_list
 361 {
 362 foreach (split(/\s+/, $_[0]->{'lists'})) {
 363         return 1 if ($_ eq "*" || $_ eq $_[1]);
 364         }
 365 return 0;
 366 }
 367
 368 # homedir_valid(&config)
 369 sub homedir_valid
 370 {
 371 local $homedir = &find_value("homedir", $_[0]);
 372 if (!-d $homedir) {
 373         local $homeused;
 374         foreach $c (@$conf) {
 375                 $homeused++ if ($c->{'value'} =~ /\$homedir/);
 376                 }
 377         if ($homeused) {
 378                 return 0;
 379                 }
 380         }
 381 return 1;
 382 }
 383
 384 1;
 385