Girocco/Util.pm

   1 package Girocco::Util;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Girocco::Config;
   7 use Time::Local;
   8
   9 BEGIN {
  10         use base qw(Exporter);
  11         our @EXPORT = qw(scrypt jailed_file sendmail_pipe mailer_pipe
  12                          lock_file unlock_file valid_tag rand_adjust
  13                          filedb_atomic_append filedb_atomic_edit filedb_grep
  14                          filedb_atomic_grep valid_email valid_email_multi
  15                          valid_repo_url valid_web_url url_base url_path url_server
  16                          projects_html_list parse_rfc2822_date parse_any_date);
  17 }
  18
  19
  20 sub scrypt {
  21         my ($pwd) = @_;
  22         crypt($pwd||'', join ('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
  23 }
  24
  25 sub jailed_file {
  26         my ($filename) = @_;
  27         $filename =~ s,^/,,;
  28         $Girocco::Config::chroot."/$filename";
  29 }
  30
  31 sub lock_file {
  32         my ($path) = @_;
  33
  34         $path .= '.lock';
  35
  36         use Errno qw(EEXIST);
  37         use Fcntl qw(O_WRONLY O_CREAT O_EXCL);
  38         use IO::Handle;
  39         my $handle = new IO::Handle;
  40
  41         unless (sysopen($handle, $path, O_WRONLY|O_CREAT|O_EXCL)) {
  42                 my $cnt = 0;
  43                 while (not sysopen($handle, $path, O_WRONLY|O_CREAT|O_EXCL)) {
  44                         ($! == EEXIST) or die "$path open failed: $!";
  45                         ($cnt++ < 16) or die "$path open failed: cannot open lockfile";
  46                         sleep(1);
  47                 }
  48         }
  49         # XXX: filedb-specific
  50         chmod 0664, $path or die "$path g+w failed: $!";
  51
  52         $handle;
  53 }
  54
  55 sub _is_passwd_file {
  56         return defined($_[0]) && $_[0] eq jailed_file('/etc/passwd');
  57 }
  58
  59 sub _run_update_pwd_db {
  60         my ($path, $updatearg) = @_;
  61         my @cmd = ($Girocco::Config::basedir.'/bin/update-pwd-db', "$path");
  62         push(@cmd, $updatearg) if $updatearg;
  63         system(@cmd) == 0 or die "update-pwd-db failed: $?";
  64 }
  65
  66 sub unlock_file {
  67         my ($path, $noreplace, $updatearg) = @_;
  68
  69         if (!$noreplace) {
  70                 _run_update_pwd_db("$path.lock", $updatearg)
  71                         if $Girocco::Config::update_pwd_db && _is_passwd_file($path);
  72                 rename "$path.lock", $path or die "$path unlock failed: $!";
  73         } else {
  74                 unlink "$path.lock" or die "$path unlock failed: $!";
  75         }
  76 }
  77
  78 sub filedb_atomic_append {
  79         my ($file, $line, $updatearg) = @_;
  80         my $id = 65536;
  81
  82         open my $src, '<', $file or die "$file open for reading failed: $!";
  83         my $dst = lock_file($file);
  84
  85         while (<$src>) {
  86                 my $aid = (split /:/)[2];
  87                 $id = $aid + 1 if ($aid >= $id);
  88
  89                 print $dst $_ or die "$file(l) write failed: $!";
  90         }
  91
  92         $line =~ s/\\i/$id/g;
  93         print $dst "$line\n" or die "$file(l) write failed: $!";
  94
  95         close $dst or die "$file(l) close failed: $!";
  96         close $src;
  97
  98         unlock_file($file, 0, $updatearg);
  99
 100         $id;
 101 }
 102
 103 sub filedb_atomic_edit {
 104         my ($file, $fn, $updatearg) = @_;
 105
 106         open my $src, '<', $file or die "$file open for reading failed: $!";
 107         my $dst = lock_file($file);
 108
 109         while (<$src>) {
 110                 print $dst $fn->($_) or die "$file(l) write failed: $!";
 111         }
 112
 113         close $dst or die "$file(l) close failed: $!";
 114         close $src;
 115
 116         unlock_file($file, 0, $updatearg);
 117 }
 118
 119 sub filedb_atomic_grep {
 120         my ($file, $fn) = @_;
 121         my @results = ();
 122
 123         open my $src, '<', $file or die "$file open for reading failed: $!";
 124         my $dst = lock_file($file);
 125
 126         while (<$src>) {
 127                 my $result = $fn->($_);
 128                 push(@results, $result) if $result;
 129         }
 130
 131         close $dst or die "$file(l) close failed: $!";
 132         close $src;
 133
 134         unlock_file($file, 1);
 135         return @results;
 136 }
 137
 138 sub filedb_grep {
 139         my ($file, $fn) = @_;
 140         my @results = ();
 141
 142         open my $src, '<', $file or die "$file open for reading failed: $!";
 143
 144         while (<$src>) {
 145                 my $result = $fn->($_);
 146                 push(@results, $result) if $result;
 147         }
 148
 149         close $src;
 150
 151         return @results;
 152 }
 153
 154 sub valid_email {
 155         local $_ = $_[0];
 156         /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9.-]+$/;
 157 }
 158 sub valid_email_multi {
 159         local $_ = $_[0];
 160         # More relaxed, we just want to avoid too dangerous characters.
 161         /^[a-zA-Z0-9+._, @-]+$/;
 162 }
 163 sub valid_web_url {
 164         local $_ = $_[0];
 165         /^https?:\/\/[a-zA-Z0-9.:-]+(\/[_\%a-zA-Z0-9.\/~:?&=;-]*)?(#[a-zA-Z0-9._-]+)?$/;
 166 }
 167 sub valid_repo_url {
 168         local $_ = $_[0];
 169         /^(https?|git|svn(\+http)?|svn(\+https)?|darcs|bzr):\/\/[a-zA-Z0-9.:-]+(\/[_\%a-zA-Z0-9.\/~-]*)?$/;
 170 }
 171 my %_badtags;
 172 BEGIN {
 173         %_badtags = (
 174         about=>1, after=>1, all=>1, also=>1, an=>1, and=>1, another=>1, any=>1,
 175         are=>1, as=>1, at=>1, be=>1, because=>1, been=>1, before=>1, being=>1,
 176         between=>1, both=>1, but=>1, by=>1, came=>1, can=>1, come=>1, could=>1,
 177         did=>1, do=>1, each=>1, for=>1, from=>1, get=>1, got=>1, had=>1, has=>1,
 178         have=>1, he=>1, her=>1, here=>1, him=>1, himself=>1, his=>1, how=>1,
 179         if=>1, in=>1, into=>1, is=>1, it=>1, like=>1, make=>1, many=>1, me=>1,
 180         might=>1, more=>1, most=>1, much=>1, must=>1, my=>1, never=>1, now=>1,
 181         of=>1, on=>1, only=>1, or=>1, other=>1, our=>1, out=>1, over=>1,
 182         said=>1, same=>1, see=>1, should=>1, since=>1, some=>1, still=>1,
 183         such=>1, take=>1, than=>1, that=>1, the=>1, their=>1, them=>1, then=>1,
 184         there=>1, these=>1, they=>1, this=>1, those=>1, through=>1, to=>1,
 185         too=>1, under=>1, up=>1, very=>1, was=>1, way=>1, we=>1, well=>1,
 186         were=>1, what=>1, where=>1, which=>1, while=>1, who=>1, with=>1,
 187         would=>1, you=>1, your=>1
 188         );
 189 }
 190 # A valid tag must only have [a-zA-Z0-9:.+#_-] characters, must start with a
 191 # letter, must not be a noise word and except for 'C' must be more than one
 192 # character long and no more than 32 characters long.
 193 sub valid_tag {
 194         local $_ = $_[0] || '';
 195         return 1 if $_ eq 'C'; # Currently only allowed single letter tag
 196         return 0 unless /^[a-zA-Z][a-zA-Z0-9:.+#_-]+$/;
 197         return 0 if $_badtags{lc($_)};
 198         return length($_) <= 32 ? 1 : 0;
 199 }
 200
 201 # If the passed in argument looks like a URL, return only the stuff up through
 202 # the host:port part otherwise return the entire argument.
 203 sub url_base {
 204         my $url = shift || '';
 205         # See RFC 3968
 206         $url = $1.$2.$3.$4 if $url =~ m,^( [A-Za-z][A-Za-z0-9+.-]*: ) # scheme
 207                 ( // )          # // separator
 208                 ((?:[^\@]+\@)?) # optional userinfo
 209                 ( [^/?#]+ )     # host and port
 210                 (?:[/?#].*)?$,x; # path and optional query string and/or anchor
 211         return $url;
 212 }
 213
 214 # If the passed in argument looks like a URL, return only the stuff following
 215 # the host:port part otherwise return the entire argument.
 216 sub url_path {
 217         my $url = shift || '';
 218         my $no_empty = shift || 0;
 219         # See RFC 3968
 220         $url = $1 if $url =~ m,^(?: [A-Za-z][A-Za-z0-9+.-]*: ) # scheme
 221                 (?: // )        # // separator
 222                 (?: [^\@]+\@ )? # optional userinfo
 223                 (?: [^/?#]+ )   # host and port
 224                 ((?:[/?#].*)?)$,x; # path and optional query string and/or anchor
 225         $url = '/' if $no_empty && $url eq '';
 226         return $url;
 227 }
 228
 229 # If both SERVER_NAME and SERVER_PORT are set pass the argument through url_path
 230 # and then prefix it with the appropriate scheme (HTTPS=?on), host and port and
 231 # return it.  If a something that doesn't look like it could be the start of a
 232 # URL path comes back from url_path or SERVER_NAME is a link-local IPv6 address
 233 # then just return the argument unchanged.
 234 sub url_server {
 235         my $url = shift || '';
 236         my $path = url_path($url);
 237         return $url unless $path eq '' || $path =~ m|^[/?#]|;
 238         return $url unless $ENV{'SERVER_NAME'} && $ENV{'SERVER_PORT'} &&
 239                 $ENV{'SERVER_PORT'} =~ /^[1-9][0-9]{0,4}$/;
 240         return $url if $ENV{'SERVER_NAME'} =~ /^[[]?fe80:/i;
 241         my $server = $ENV{'SERVER_NAME'};
 242         # Deal with Apache bug where IPv6 literal server names do not include
 243         # the required surrounding '[' and ']' characters
 244         $server = '[' . $server . ']' if $server =~ /:/ && $server !~ /^[[]/;
 245         my $ishttps = $ENV{'HTTPS'} && $ENV{'HTTPS'} =~ /^on$/i;
 246         my $portnum = 0 + $ENV{'SERVER_PORT'};
 247         my $port = '';
 248         if (($ishttps && $portnum != 443) || (!$ishttps && $portnum != 80)) {
 249                 $port = ':' . $portnum;
 250         }
 251         return 'http' . ($ishttps ? 's' : '') . '://' . $server . $port . $path;
 252 }
 253
 254 sub _escapeHTML {
 255         my $str = shift;
 256         $str =~ s/\&/\&amp;/gs;
 257         $str =~ s/\</\&lt;/gs;
 258         $str =~ s/\>/\&gt;/gs;
 259         $str =~ s/\"/\&quot;/gs; #"
 260         return $str;
 261 }
 262
 263 # create relative time string from passed in age in seconds
 264 sub _rel_age {
 265         my $age = shift;
 266         my $age_str;
 267
 268         if ($age > 60*60*24*365*2) {
 269                 $age_str = (int $age/60/60/24/365);
 270                 $age_str .= " years ago";
 271         } elsif ($age > 60*60*24*(365/12)*2) {
 272                 $age_str = int $age/60/60/24/(365/12);
 273                 $age_str .= " months ago";
 274         } elsif ($age > 60*60*24*7*2) {
 275                 $age_str = int $age/60/60/24/7;
 276                 $age_str .= " weeks ago";
 277         } elsif ($age > 60*60*24*2) {
 278                 $age_str = int $age/60/60/24;
 279                 $age_str .= " days ago";
 280         } elsif ($age > 60*60*2) {
 281                 $age_str = int $age/60/60;
 282                 $age_str .= " hours ago";
 283         } elsif ($age > 60*2) {
 284                 $age_str = int $age/60;
 285                 $age_str .= " mins ago";
 286         } elsif ($age > 2) {
 287                 $age_str = int $age;
 288                 $age_str .= " secs ago";
 289         } elsif ($age >= 0) {
 290                 $age_str = "right now";
 291         } else {
 292                 $age_str = "future time";
 293         }
 294         return $age_str;
 295 }
 296
 297 # create relative time string from passed in idle in seconds
 298 sub _rel_idle {
 299         my $idle_str = _rel_age(shift);
 300         $idle_str =~ s/ ago//;
 301         $idle_str = "not at all" if $idle_str eq "right now";
 302         return $idle_str;
 303 }
 304
 305 sub _strftime {
 306         use POSIX qw(strftime);
 307         my ($fmt, $secs, $zonesecs) = @_;
 308         my ($S,$M,$H,$d,$m,$y) = gmtime($secs + $zonesecs);
 309         $zonesecs = int($zonesecs / 60);
 310         $fmt =~ s/%z/\$z/g;
 311         my $ans = strftime($fmt, $S, $M, $H, $d, $m, $y, -1, -1, -1);
 312         my $z;
 313         if ($zonesecs < 0) {
 314                 $z = "-";
 315                 $zonesecs = -$zonesecs;
 316         } else {
 317                 $z = "+";
 318         }
 319         $z .= sprintf("%02d%02d", int($zonesecs/60), $zonesecs % 60);
 320         $ans =~ s/\$z/$z/g;
 321         return $ans;
 322 }
 323
 324 # Take a list of project names and produce a nicely formated table that
 325 # includes owner links and descriptions.  If the list is empty returns ''.
 326 # The first argument may be a hash ref that contains options.  The following
 327 # options are available:
 328 #   target  -- sets the target value of the owner link
 329 #   emptyok -- if true returns an empty table rather than ''
 330 #   typecol -- if true include type column with hover info
 331 #   changed -- if true include a changed and idle column
 332 sub projects_html_list {
 333         my $options = {};
 334         if (defined($_[0]) && ref($_[0]) eq 'HASH') {
 335                 $options = shift;
 336         }
 337         return '' unless @_ || (defined($options->{emptyok}) && $options->{emptyok});
 338         require Girocco::Project;
 339         my $count = 0;
 340         my $target = '';
 341         $target = " target=\""._escapeHTML($options->{target})."\""
 342                 if defined($options->{target});
 343         my $withtype = defined($options->{typecol}) && $options->{typecol};
 344         my $withchanged = defined($options->{changed}) && $options->{changed};
 345         my $typehead = '';
 346         $typehead = '<th>Type</th>' if $withtype;
 347         my $chghead = '';
 348         $chghead = substr(<<EOT, 0, -1) if $withchanged;
 349 <th><span class="hover">Changed<span><span class="head">Changed</span
 350 />The last time a ref change was received by this site.</span></span></th
 351 ><th><span class="hover">Idle<span><span class="head">Idle</span
 352 />The most recent committer time in <i>refs/heads</i>.</span></span></th
 353 >
 354 EOT
 355         my $html = <<EOT;
 356 <table class='projectlist'><tr><th>Project</th>$typehead$chghead<th class="desc">Description</th></tr>
 357 EOT
 358         my $trclass = ' class="odd"';
 359         foreach (sort({lc($a) cmp lc($b)} @_)) {
 360                 if (Girocco::Project::does_exist($_, 1)) {
 361                         my $proj = Girocco::Project->load($_);
 362                         my $projname = $proj->{name}.".git";
 363                         my $projdesc = $proj->{desc}||'';
 364                         utf8::decode($projdesc) if utf8::valid($projdesc);
 365                         my $typecol = '';
 366                         if ($withtype) {
 367                                 if ($proj->{mirror}) {
 368                                         $typecol = substr(<<EOT, 0, -1);
 369 <td class="type"><span class="hover">mirror<span class="nowrap">@{[_escapeHTML($proj->{url})]}</span></span></td>
 370 EOT
 371                                 } else {
 372                                         my $users = @{$proj->{users}};
 373                                         $users .= ' user';
 374                                         $users .= 's' unless @{$proj->{users}} == 1;
 375                                         my $userlist = join(', ', sort({lc($a) cmp lc($b)} @{$proj->{users}}));
 376                                         my $spncls = length($userlist) > 25 ? '' : ' class="nowrap"';
 377                                         $typecol = $userlist ? substr(<<EOT, 0, -1) : substr(<<EOT, 0, -1);
 378 <td class="type"><span class="hover">$users<span$spncls>$userlist</span></span></td>
 379 EOT
 380 <td class="type">$users</td>
 381 EOT
 382                                 }
 383                         }
 384                         my $changecol = '';
 385                         if ($withchanged) {
 386                                 my $rel = '';
 387                                 my $changetime = $proj->{lastchange};
 388                                 if ($changetime) {
 389                                         $rel = "<span class=\"hover\">" .
 390                                                 _rel_age(time - parse_rfc2822_date($changetime)) .
 391                                                 "<span class=\"nowrap\">$changetime</span></span>";
 392                                 } else {
 393                                         $rel = "no commits";
 394                                 }
 395                                 $changecol = substr(<<EOT, 0, -1);
 396 <td class="change">$rel</td>
 397 EOT
 398                                 my $idletime = $proj->{lastactivity};
 399                                 my ($idlesecs, $tz);
 400                                 $idlesecs = parse_any_date($idletime, \$tz) if $idletime;
 401                                 if ($idlesecs) {
 402                                         my $idle2822 = _strftime("%a, %d %b %Y %T %z", $idlesecs, $tz);
 403                                         $rel = "<span class=\"hover\">" .
 404                                                 _rel_idle(time - $idlesecs) .
 405                                                 "<span class=\"nowrap\">$idle2822</span></span>";
 406                                 } else {
 407                                         $rel = "no commits";
 408                                 }
 409                                 $changecol .= substr(<<EOT, 0, -1);
 410 <td class="idle">$rel</td>
 411 EOT
 412                         }
 413                         $html .= <<EOT;
 414 <tr$trclass><td><a href="@{[url_path($Girocco::Config::gitweburl)]}/$projname"$target
 415 >@{[_escapeHTML($projname)]}</td>$typecol$changecol<td>@{[_escapeHTML($projdesc)]}</td></tr>
 416 EOT
 417                         $trclass = $trclass ? '' : ' class="odd"';
 418                         ++$count;
 419                 }
 420         }
 421         $html .= <<EOT;
 422 </table>
 423 EOT
 424         return ($count || (defined($options->{emptyok}) && $options->{emptyok})) ? $html : '';
 425 }
 426
 427 my %_month_names;
 428 BEGIN {
 429         %_month_names = (
 430                 jan => 0, feb => 1, mar => 2, apr => 3, may => 4, jun => 5,
 431                 jul => 6, aug => 7, sep => 8, oct => 9, nov => 10, dec => 11
 432         );
 433 }
 434
 435 # Should be in "date '+%a, %d %b %Y %T %z'" format as saved to lastgc, lastrefresh and lastchange
 436 # The leading "%a, " is optional, returns undef if unrecognized date.  This is also known as
 437 # RFC 2822 date format and git's '%cD', '%aD' and --date=rfc2822 format.
 438 # If the second argument is a SCALAR ref, its value will be set to the TZ offset in seconds
 439 sub parse_rfc2822_date {
 440         my $dstr = shift || '';
 441         my $tzoff = shift || '';
 442         $dstr = $1 if $dstr =~/^[^\s]+,\s*(.*)$/;
 443         return undef unless $dstr =~
 444                 /^\s*(\d{1,2})\s+([A-Za-z]{3})\s+(\d{4})\s+(\d{1,2}):(\d{2}):(\d{2})\s+([+-]\d{4})\s*$/;
 445         my ($d,$b,$Y,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7);
 446         my $m = $_month_names{lc($b)};
 447         return undef unless defined($m);
 448         my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, 0+$m, $Y-1900);
 449         my $offset = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
 450         $offset = -$offset if substr($z,0,1) eq '-';
 451         $$tzoff = $offset if ref($tzoff) eq 'SCALAR';
 452         return $seconds - $offset;
 453 }
 454
 455 # Will parse any supported date format.  Actually there are three formats
 456 # currently supported:
 457 #   1. RFC 2822 (uses parse_rfc2822_date)
 458 #   2. RFC 3339 / ISO 8601 (T may be ' ', 'Z' is optional, ':' optional in TZ)
 459 #   3. unix seconds since epoch with optional +/- trailing TZ (may not have a ':')
 460 # Returns undef if unsupported date.
 461 # If the second argument is a SCALAR ref, its value will be set to the TZ offset in seconds
 462 sub parse_any_date {
 463         my $dstr = shift || '';
 464         my $tzoff = shift || '';
 465         if ($dstr =~ /^\s*([-+]?\d+)(?:\s+([-+]\d{4}))?\s*$/) {
 466                 # Unix timestamp
 467                 my $ts = 0 + $1;
 468                 my $off = 0;
 469                 if ($2) {
 470                         my $z = $2;
 471                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
 472                         $off = -$off if substr($z,0,1) eq '-';
 473                 }
 474                 $$tzoff = $off if ref($tzoff) eq 'SCALAR';
 475                 return $ts;
 476         }
 477         if ($dstr =~ /^\s*(\d{4})-(\d{2})-(\d{2})[Tt ](\d{2}):(\d{2}):(\d{2})(?:[ ]([Zz]|(?:[-+]\d{2}:?\d{2})))?\s*$/) {
 478                 my ($Y,$m,$d,$H,$M,$S,$z) = ($1,$2,$3,$4,$5,$6,$7||'');
 479                 my $seconds = timegm(0+$S, 0+$M, 0+$H, 0+$d, $m-1, $Y-1900);
 480                 $z =~ s/://;
 481                 my $off = 0;
 482                 if (uc($z) ne 'Z') {
 483                         $off = 60 * (60 * (0+substr($z,1,2)) + (0+substr($z,3,2)));
 484                         $off = -$off if substr($z,0,1) eq '-';
 485                 }
 486                 $$tzoff = $off if ref($tzoff) eq 'SCALAR';
 487                 return $seconds - $off;
 488         }
 489         return parse_rfc2822_date($dstr, $tzoff);
 490 }
 491
 492 # Input is a number such as a minute interval
 493 # Return value is a random number between the input and 1.25*input
 494 # This can be used to randomize the update and gc operations a bit to avoid
 495 # having them all end up all clustered together
 496 sub rand_adjust {
 497         my $input = shift || 0;
 498         return $input unless $input;
 499         return $input + int(rand(0.25 * $input));
 500 }
 501
 502 # Open a pipe to a new sendmail process.  The '-i' option is always passed to
 503 # the new process followed by any addtional arguments passed in.  Note that
 504 # the sendmail process is only expected to understand the '-i', '-t' and '-f'
 505 # options.  Using any other options via this function is not guaranteed to work.
 506 # A list of recipients may follow the options.  Combining a list of recipients
 507 # with the '-t' option is not recommended.
 508 sub sendmail_pipe {
 509         return undef unless @_;
 510         die "\$Girocco::Config::sendmail_bin is unset or not executable!\n"
 511                 unless $Girocco::Config::sendmail_bin && -x $Girocco::Config::sendmail_bin;
 512         my $result = open(my $pipe, '|-', $Girocco::Config::sendmail_bin, '-i', @_);
 513         return $result ? $pipe : undef;
 514 }
 515
 516 # Open a pipe that works similarly to a mailer such as /usr/bin/mail in that
 517 # if the first argument is '-s', a subject line will be automatically added
 518 # (using the second argument as the subject).  Any remaining arguments are
 519 # expected to be recipient addresses that will be added to an explicit To:
 520 # line as well as passed on to sendmail_pipe.  In addition an
 521 # "Auto-Submitted: auto-generated" header is always added as well as a suitable
 522 # "From:" header.
 523 sub mailer_pipe {
 524         my $subject = undef;
 525         if (@_ >= 2 && $_[0] eq '-s') {
 526                 shift;
 527                 $subject = shift;
 528         }
 529         my $tolist = join(", ", @_);
 530         unshift(@_, '-f', $Girocco::Config::sender) if $Girocco::Config::sender;
 531         my $pipe = sendmail_pipe(@_);
 532         if ($pipe) {
 533                 print $pipe "From: \"$Girocco::Config::name\" ",
 534                         "($Girocco::Config::title) ",
 535                         "<$Girocco::Config::admin>\n";
 536                 print $pipe "To: $tolist\n";
 537                 print $pipe "Subject: $subject\n" if defined($subject);
 538                 print $pipe "Auto-Submitted: auto-generated\n";
 539                 print $pipe "\n";
 540         }
 541         return $pipe;
 542 }
 543
 544 1;