Fix email headers formatting

[projects/distfiles.git] / request-handler.pl

#!/usr/bin/perl -w
# read email with request from stdin and process it

use Sys::Syslog;

openlog("distfiles-rh", "pid", "user"); 

$spool_dir = "./spool";
$commits_list = "pld-cvs-commit\@lists.pld-linux.org";

$spec = undef;
$branch = "";
$from = undef;
$flags = "";

# ---------------------------------------------------------------
use File::Basename;
use File::Copy;
use Cwd;

sub cleanup()
{
  system("rm -rf tmp/$id");
}

sub report_fatal($)
{
  my $msg = shift;

  syslog("err","FATAL: $msg");
  cleanup();

  my $email_head =
"From: $from <$from\@pld-linux.org>
Subject: DISTFILES: ERROR fetching sources for $spec ($branch)
X-distfiles-program: request-handler.pl";
  my $email_body =
"$msg

-- 
Virtually Yours: distfiles.
";

  open(M, "| /usr/sbin/sendmail -t") or die("/usr/sbin/sendmail not found");
  #open(M, "| cat") or die;
  print M
"To: $commits_list
$email_head
Message-ID: <$$." . time . "$id\@distfiles.pld-linux.org>

$email_body";
  close(M) or die("problem while sending email");
  
  open(M, "| /usr/sbin/sendmail -t") or die("/usr/sbin/sendmail not found");
  #open(M, "| cat") or die;
  print M
"To: <$from\@pld-linux.org>
$email_head
Message-ID: <$$." . time . "$id\@distfiles.pld-linux.org>

$email_body";
  close(M) or die("problem while sending email");
  exit 0;
}
# ---------------------------------------------------------------

$id = `uuidgen`;
chomp $id;
$id = rand if (!defined $id or $id eq "");

my $ref_pattern='[0-9a-zA-Z][0-9#a-zA-Z._\@/+ :,-]*';
while (<STDIN>) {
  chomp;
  /^X-Package: ([a-z0-9_.+-]+)/i and $spec = $1;
  /^X-Branch: ($ref_pattern)/i and $branch = $1;
  /^X-Login: ([a-z0-9_.]+)/i and $from = $1;
  /^X-Flags: ([a-z0-9_ -]+)/i and $flags = $1;
}

if (!defined $from) {
   syslog("err","FATAL: ill-formed request");
   die "ill-formed request";
}

syslog("info","got request from $from for $spec at $branch ($flags)");

report_fatal("bad spec name") if (!defined $spec);

$oldcwd = Cwd::getcwd();

mkdir("tmp/$id") or die("cannot create: tmp/$id");
chdir("tmp/$id");

my $cvs_get = `~/distfiles/show_spec.sh $spec $branch 2>&1`;
if ( $? ) {
  chdir($oldcwd);
  my $at_branch = "";
  $at_branch = " from branch $branch" if $branch;
  my $code = $? >> 8;
  report_fatal("cannot git fetch $spec$at_branch;\n$cvs_get\nexited with code $code");
}

chdir($oldcwd);

syslog("info","spooling to tmp/$id/to-spool");
open(S, "> tmp/$id/to-spool");
print S "$from\@pld-linux.org\n";
print S "$spec\n";
print S "$flags\n";
close(S);

if (system("perl ./specparser.pl \"tmp/$id/$spec\" tmp/$id/sources >> tmp/$id/to-spool") != 0) {
  report_fatal("cannot parse $spec ($branch)")
}

if (!File::Copy::move("tmp/$id/to-spool", "$spool_dir/$id")) {
  syslog("err","FATAL: move failed: $!");
  die("move failed: $!");
}

cleanup();

exit(0);

# vim: ts=2:sw=2:et