- really send emails

[projects/distfiles.git] / file-fetcher.pl

#!/usr/bin/perl -w
#

$spool_dir = "./spool";
$ftp_dir = "./ftp";
$email_cc = "";


@md5 = ();
%url = ();
$problems = "";
$normal_out = "";
$requester = "";
$file = "";
$fetched_count = 0;
$force_reply = 0;

# try lookup some file in spool, exit if it cannot be done
sub find_file_in_spool()
{
  opendir(DIR, $spool_dir) || die "can't opendir $spool_dir: $!";
  while (1) {
    my $f = readdir(DIR);
    defined $f or last;
    -f "$spool_dir/$f" or next;
    $file = "$spool_dir/$f";
    last;
  }
  closedir(DIR);

  exit 0 if ($file eq "");
}

# read file from spool, and try unlink it. if cannot unlink -- exit
# sets $requester (email), $problems, @md5 (arrays of md5's) 
# and %url (map from md5 to urls)
sub read_spool_file()
{
  open(F, "< $file") || exit 0;
  $requester = <F>;
  chomp $requester;
  $requester =~ /^[a-zA-Z_\-0-9\@\.]+$/ 
	or die "$file: evil requester: $requester";
  my $flags = <F>;
  $force_reply++ if ($flags =~ /force-reply/);
	
  while (<F>) {
    if (/^ERROR/) {
      s/^ERROR: //;
      $problems .= $_;
    }
    /^([a-f0-9]{32})\s+((ftp|http):\/\/([a-z0-9A-Z:\+\~\.\-\/_]|\%[0-9])+)\s*$/ 
  	or die "$file: corrupted";
    push @md5, $1;
    $url{$1} = $2;
    /\/$/ and die "$file: cannot fetch dir";
  }
  close(F);

  unlink($file) || exit 0;
}

sub file_path($$)
{
  my ($md5, $url) = @_;
  
  $md5 =~ /^(.)(.)/;
  my $md5_dir = "$ftp_dir/by-md5/$1/$2/$md5";
  $url =~ /\/([^\/]+)$/ or die;
  my $basename = $1;
  return "$md5_dir/$basename";
}

sub install_dir
{
  my $dir = shift;
  return if (-e $dir);
  $dir =~ /(.*)\/[^\/]+$/ and install_dir($1);
  mkdir($dir);
}

sub move_file($$)
{
  my ($md5, $url) = @_;

  my $path = file_path($md5, $url);
  
  $path =~ /(.*)\/[^\/]+$/ and install_dir($1);
  
  if (system("mv -f \"tmp/$md5\" \"$path\"")) {
    $problems .= "FATAL: cannot mv file ($url)\n";
  } else {
    $normal_out .= "STORED: $url ($md5, " .  (-s $path) . " bytes)\n";
    $fetched_count++;
  }
}

sub fetch_file($$)
{
  my ($md5, $url) = @_;
  my $out = "";
  my $cmd = "wget -nv -O tmp/$md5 \"$url\"";
  
  my $path = file_path($md5, $url);
  if (-f $path) {
    $normal_out .= "ALREADY GOT: $url ($md5, " .  (-s $path) . " bytes)\n";
    return;
  }
    
  open(W, "$cmd 2>&1 |");
  while (<W>) {
    /URL:.*\s+\-\>\s+.*/ and next;
    $out .= $_;
  }
  close(W);
  if ($out ne "") {
    $problems .= "$cmd:\n$out\n\n";
  }
  if (-f "tmp/$md5" && -s "tmp/$md5" > 0) {
    my $computed_md5 = `md5sum tmp/$md5`;
    $computed_md5 =~ /^([a-f0-9]{32})/ and $computed_md5 = $1;
    if ($computed_md5 ne $md5) {
      $problems .= "FATAL: $url md5 mismatch, needed $md5, got $computed_md5\n";
    } else {
      move_file($md5, $url);
    }
  } else {
    $problems .= "FATAL: $url ($md5) was not fetched\n";
  }
  unlink("tmp/$md5");
}

sub fetch_files()
{
  $problems .= "\n\n" if ($problems ne "");
  foreach $md5 (@md5) {
    fetch_file($md5, $url{$md5});
  }
}

sub send_email()
{
  open(EMAIL, "| /usr/sbin/sendmail -t");
  #open(EMAIL, "| cat");
  my $marker = "OK";
  if ($problems ne "") {
    $marker = "ERRORS";
  }
  print EMAIL 
"From: distfiles <feedback\@pld-linux.org>
To: $requester
Cc: $email_cc
Subject: [distfiles] sources fetched $marker
Message-ID: <$$." . time . "\@distfiles.pld-linux.org>
X-distfiles-program: file-fetcher.pl
X-distfiles-version: " . '$Id$' . "

$problems
Files fetched: $fetched_count

$normal_out

-- 
Virtually yours: distfiles.
";
  close(EMAIL) or die;
}

find_file_in_spool();
read_spool_file();
fetch_files();
send_email() unless (!$force_reply and $problems eq "" and $fetched_count == 0);