request-handler.pl

   1 #!/usr/bin/perl -w
   2 # read email with request from stdin and process it
   3
   4 use Sys::Syslog;
   5
   6 openlog("distfiles-rh", "pid", "user");
   7
   8 $spool_dir = "./spool";
   9 $commits_list = "pld-cvs-commit\@lists.pld-linux.org";
  10
  11 $spec = undef;
  12 $branch = "";
  13 $from = undef;
  14 $flags = "";
  15
  16 # ---------------------------------------------------------------
  17 use File::Basename;
  18 use File::Copy;
  19 use Cwd;
  20
  21 sub cleanup()
  22 {
  23   system("rm -rf tmp/$id");
  24 }
  25
  26 sub report_fatal($)
  27 {
  28   my $msg = shift;
  29
  30   syslog("err","FATAL: $msg");
  31   cleanup();
  32
  33   my $email_head =
  34 "Subject: DISTFILES: ERROR fetching sources for $spec ($branch)
  35 X-distfiles-program: request-handler.pl";
  36   my $email_body =
  37 "$msg
  38
  39 --
  40 Virtually Yours: distfiles.
  41 ";
  42
  43   open(M, "| /usr/sbin/sendmail -t") or die("/usr/sbin/sendmail not found");
  44   #open(M, "| cat") or die;
  45   print M
  46 "From: $from <$from\@pld-linux.org>
  47 To: $commits_list
  48 $email_head
  49 Message-ID: <$$." . time . "$id\@distfiles.pld-linux.org>
  50
  51 Requester: $from
  52
  53 $email_body";
  54   close(M) or die("problem while sending email");
  55
  56   open(M, "| /usr/sbin/sendmail -t") or die("/usr/sbin/sendmail not found");
  57   #open(M, "| cat") or die;
  58   print M
  59 "From: <distfiles\@distfiles.pld-linux.org>
  60 To: <$from\@pld-linux.org>
  61 $email_head
  62 Message-ID: <$$." . time . "$id\@distfiles.pld-linux.org>
  63
  64 $email_body";
  65   close(M) or die("problem while sending email");
  66   exit 0;
  67 }
  68 # ---------------------------------------------------------------
  69
  70 $id = `uuidgen`;
  71 chomp $id;
  72 $id = rand if (!defined $id or $id eq "");
  73
  74 my $ref_pattern='[0-9a-zA-Z][0-9#a-zA-Z._\@/+ :,-]*';
  75 while (<STDIN>) {
  76   chomp;
  77   /^X-Package: ([a-z0-9_.+-]+)/i and $spec = $1;
  78   /^X-Branch: ($ref_pattern)/i and $branch = $1;
  79   /^X-Login: ([a-z0-9_.]+)/i and $from = $1;
  80   /^X-Flags: ([a-z0-9_ -]+)/i and $flags = $1;
  81 }
  82
  83 if (!defined $from) {
  84    syslog("err","FATAL: ill-formed request");
  85    die "ill-formed request";
  86 }
  87
  88 syslog("info","got request from $from for $spec at $branch ($flags)");
  89
  90 report_fatal("bad spec name") if (!defined $spec);
  91
  92 $oldcwd = Cwd::getcwd();
  93
  94 mkdir("tmp/$id") or die("cannot create: tmp/$id");
  95 chdir("tmp/$id");
  96
  97 my $cvs_get = `~/distfiles/show_spec.sh $spec $branch 2>&1`;
  98 if ( $? ) {
  99   chdir($oldcwd);
 100   my $at_branch = "";
 101   $at_branch = " from branch $branch" if $branch;
 102   my $code = $? >> 8;
 103   report_fatal("cannot git fetch $spec$at_branch;\n$cvs_get\nexited with code $code");
 104 }
 105
 106 chdir($oldcwd);
 107
 108 syslog("info","spooling to tmp/$id/to-spool");
 109 open(S, "> tmp/$id/to-spool");
 110 print S "$from\@pld-linux.org\n";
 111 print S "$spec\n";
 112 print S "$flags\n";
 113 close(S);
 114
 115 if (system("perl ./specparser.pl \"tmp/$id/$spec\" tmp/$id/sources >> tmp/$id/to-spool") != 0) {
 116   report_fatal("cannot parse $spec ($branch)")
 117 }
 118
 119 if (!File::Copy::move("tmp/$id/to-spool", "$spool_dir/$id")) {
 120   syslog("err","FATAL: move failed: $!");
 121   die("move failed: $!");
 122 }
 123
 124 cleanup();
 125
 126 exit(0);
 127
 128 # vim: ts=2:sw=2:et