#!/usr/bin/perl -w
#
# Copyright (c) 2009 Michael Schroeder, Novell Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################
#
# Sign the built packages
#

BEGIN {
  my ($wd) = $0 =~ m-(.*)/- ;
  $wd ||= '.';
  unshift @INC,  "$wd/build";
  unshift @INC,  "$wd";
}

use POSIX;
use Data::Dumper;
use Digest::MD5 ();
use Fcntl qw(:DEFAULT :flock);
use XML::Structured ':bytes';
use Build;
use Storable;

use BSConfig;
use BSRPC;
use BSUtil;
use BSXML;
use BSVerify;

use strict;

my $bsdir = $BSConfig::bsdir || "/srv/obs";

BSUtil::mkdir_p_chown($bsdir, $BSConfig::bsuser, $BSConfig::bsgroup);
BSUtil::drop_privs_to($BSConfig::bsuser, $BSConfig::bsgroup);

my $rundir = $BSConfig::rundir || "$BSConfig::bsdir/run";
my $jobsdir = "$BSConfig::bsdir/jobs";
my $eventdir = "$BSConfig::bsdir/events";
my $myeventdir = "$eventdir/signer";
my $uploaddir = "$BSConfig::bsdir/upload";

my $maxchild = 4;


sub readblk {
  my ($fd, $blk, $num, $blksize) = @_;
  $blksize ||= 2048;
  sysseek($fd, $blk * $blksize, SEEK_SET) || die("sysseek: $!\n");
  $num ||= 1;
  $num *= $blksize;
  my $ret = '';
  (sysread($fd, $ret, $num) || 0) == $num || die("sysread: $!\n");
  return $ret;
}

sub writeblk {
  my ($fd, $blk, $cnt) = @_;
  my $blksize = 2048;
  sysseek($fd, $blk * $blksize, SEEK_SET) || die("sysseek: $!\n");
  (syswrite($fd, $cnt) || 0) == length($cnt) || die("syswrite: $!\n");
}

sub signfilter {
  my ($content, @signargs) = @_;
  local (*RH, *WH);
  local *P;
  pipe(RH, WH) || die("pipe: $!\n");
  my $pid;
  $pid = open(P, '-|');
  die("fork: $!\n") unless defined $pid;
  if (!$pid) {
    close WH;
    open(STDIN, "<&RH");
    eval {
      exec($BSConfig::sign, @signargs, '-d');
      die("$BSConfig::sign: $!\n");
    };
    warn($@) if $@;
    exit 1;
  }
  close RH;
  print WH $content;
  close WH;
  my $ret = '';
  $ret .= $_ while <P>;
  close(P) || die("sign: $?\n");
  return $ret;
}

sub readisodir {
  my ($fd, $dirpos) = @_;

  my $dirblk = readblk($fd, $dirpos);
  my $dirlen = unpack('@10V', $dirblk);
  die("bad directory len\n") if $dirlen & 0x7ff;
  my $sp_bytes_skip = 0;
  my @contents;
  my $entryoff = 0;
  while ($dirlen) {
    if ($dirblk eq '' || unpack('C', $dirblk) == 0) {
      $dirlen -= 0x800;
      $dirblk = readblk($fd, ++$dirpos) if $dirlen;
      $entryoff = 0;
      next;
    }
    my ($l, $fpos, $flen, $f, $inter, $nl) = unpack('C@2V@10V@25Cv@32C', $dirblk);
    die("bad dir entry\n") if $l > length($dirblk);
    if ($f & 2) {
      $dirblk = substr($dirblk, $l);
      $entryoff += $l;
      next;
    }
    die("associated file\n") if $f & 4;
    die("interleaved file\n") if $inter;
    die("bad dir entry\n") if !$nl || $nl + 33 > length($dirblk);
    $nl++ unless $nl & 1;
    my $e = substr($dirblk, $nl + 33, $l - $nl - 33);
    if (length($e) >= 7 && substr($e, 0, 2) eq 'SP') {
      ($sp_bytes_skip) = unpack('@6C', $e);
    } else {
      $e = substr($e, $sp_bytes_skip) if $sp_bytes_skip;
    }
    my ($ce_len, $ce_blk, $ce_off) = (0, 0, 0);
    my $fname = '';
    my $nmf = 0;
    while ($e ne '') {
      if (length($e) <= 2) {
        last unless $ce_len;
	$e = readblk($fd, $ce_blk);
        $e = substr($e, $ce_off, $ce_len);
        $ce_len = 0;
	next;
      }
      if (substr($e, 0, 2) eq 'CE') {
	($ce_blk, $ce_off, $ce_len) = unpack('@4V@12V@20V', $e);
      } elsif (substr($e, 0, 2) eq 'NM') {
	my $nml = (unpack('@2C', $e))[0] - 5;
	$fname = '' unless $nmf & 1;
	($nmf) = unpack('@4C', $e);
        $fname .= substr($e, 5, $nml) if $nml > 0;
      }
      $e = substr($e, (unpack('@2C', $e))[0]);
    }
    push @contents, [$fname, $fpos, $flen, $dirpos, $entryoff];
    $dirblk = substr($dirblk, $l);
    $entryoff += $l;
  }
  return @contents;
}

sub signisofiles {
  my ($fd, @signargs) = @_;

  my $signed = 0;
  my $vol = readblk($fd, 16);
  die("primary volume descriptor missing\n") if substr($vol, 0, 6) ne "\001CD001";
  my ($path_table_size, $path_table_pos) = unpack('@132V@140V', $vol);
  my $path_table = readblk($fd, $path_table_pos * 2048, $path_table_size, 1);
  while ($path_table ne '') {
    my ($l, $dirpos) = unpack('C@2V', $path_table);
    die("empty dir in path table\n") unless $l;
    $path_table = substr($path_table, 8 + $l + ($l & 1));
    my @c = readisodir($fd, $dirpos);
    for my $e (@c) {
      #print "$e->[0] $e->[1] $e->[2] $e->[3] $e->[4]\n";
      if ($e->[0] =~ /^(.*).asc$/i && $e->[2] == 2048) {
	my $n = $1;
	my $signfile = readblk($fd, $e->[1]);
	next if substr($signfile, 0, 8) ne "sIGnMe!\n";
	my $len = hex(substr($signfile, 8, 8));
	my $sum = hex(substr($signfile, 16, 8));
	my @se = grep {$_->[0] =~ /^\Q$n\E$/i && $_->[2] == $len} @c;
	die("don't know which file to sign: $e->[0]\n") unless @se == 1;
	my $sf = readblk($fd, $se[0]->[1], ($len + 0x7ff) >> 11);
	$sf = substr($sf, 0, $len);
        die("selected wrong file\n") if $sum != unpack("%32C*", $sf);
	my $sig = signfilter($sf, @signargs);
	die("returned signature is empty\n") unless $sig;
	die("returned signature is too big\n") if length($sig) > 2048;
	# replace old content
	writeblk($fd, $e->[1], $sig . ("\0" x (2048 - length($sig))));
	my $dirblk = readblk($fd, $e->[3]);
	# patch in new content len
	substr($dirblk, $e->[4] + 10, 4) = pack('V', length($sig));
	writeblk($fd, $e->[3], $dirblk);
	$signed++;
      }
    }
  }
  return $signed;
}

sub retagmd5iso {
  my ($fd) = @_;
  my $blk = readblk($fd, 0, 17);
  die("primary volume descriptor missing\n") if substr($blk, 0x8000, 6) ne "\001CD001";
  my $tags = ';'.substr($blk, 0x8373, 0x200);
  return unless $tags =~ /;md5sum=[0-9a-fA-F]{32}/;
  print "updating md5sum tag\n";
  substr($blk, 0x0000, 0x200) = "\0" x 0x200;
  substr($blk, 0x8373, 0x200) = ' ' x 0x200;
  my $numblks = unpack("V", substr($blk, 0x8050, 4));
  die("bad block number\n") if $numblks < 17;
  my $md5 = Digest::MD5->new;
  $md5->add($blk);
  $numblks -= 17;
  my $blkno = 16;
  while ($numblks-- > 0) {
    my $b = readblk($fd, ++$blkno);
    $md5->add($b);
  }
  $md5 = $md5->hexdigest;
  $tags =~ s/;md5sum=[0-9a-fA-F]{32}/;md5sum=$md5/;
  substr($blk, 0x8373, 0x200) = substr($tags, 1);
  writeblk($fd, 16, substr($blk, 0x8000, 0x800));
}

sub signiso {
  my ($file, @signargs) = @_;
  local *ISO;
  open(ISO, '+<', $file) || die("$file: $!\n");
  my $signed = signisofiles(\*ISO, @signargs);
  retagmd5iso(\*ISO) if $signed;
  close(ISO) || die("close $file: $!\n");
}

sub signjob {
  my ($job, $arch) = @_;

  print "signing $arch/$job\n";
  local *F;
  if (! -e "$jobsdir/$arch/$job") {
    print "no such job\n";
    return undef;
  }
  if (! -e "$jobsdir/$arch/$job:status") {
    print "job is not done\n";
    return undef;
  }
  my $jobstatus = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  # finished can be removed here later, but running jobs shall not be lost on code update.
  if ($jobstatus->{'code'} ne 'finished' && $jobstatus->{'code'} ne 'signing') {
    print "job is not assigned for signing\n";
    close F;
    return undef;
  }
  my $jobdir = "$jobsdir/$arch/$job:dir";
  die("jobdir does not exist\n") unless -d $jobdir;
  my $info = readxml("$jobsdir/$arch/$job", $BSXML::buildinfo);
  my $projid = $info->{'project'};
  my @files = sort(ls($jobdir));
  my @signfiles = grep {/\.(?:d?rpm|sha256|iso)$/} @files;
  if (grep {$_ eq '.kiwitree_tosign'} @files) {
    for my $f (split("\n", readstr("$jobdir/.kiwitree_tosign"))) {
      next if $f eq '';
      $f =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
      die("bad file in kiwitree_tosign: $f\n") if "/$f/" =~ /\/\.{0,2}\//s;
      die("bad file in kiwitree_tosign: $f\n") unless $f =~ /^(.*)\.asc$/s;
      push @signfiles, $f if -s "$jobdir/$f" && -e "$jobdir/$1";
    }
  }
  if (@signfiles) {
    my @signargs;
    push @signargs, '--project', $projid if $BSConfig::sign_project || $BSConfig::sign_project;
    my $param = {
      'uri' => "$BSConfig::srcserver/getsignkey",
      'timeout' => 60,
    };
    my $signkey = BSRPC::rpc($param, undef, "project=$projid");
    if ($signkey) {
      mkdir_p($uploaddir);
      writestr("$uploaddir/signer.$$", undef, $signkey);
      push @signargs, '-P', "$uploaddir/signer.$$";
    }
    for my $signfile (@signfiles) {
      if ($info->{'file'} eq '_aggregate' && ($signfile =~ /\.d?rpm$/)) {
	# special aggregate handling: remove old sigs
        system('rpm', '--delsign', "$jobdir/$signfile") && warn("delsign $jobdir/$signfile failed: $?\n");
      }
      if ($signfile =~ /\.iso$/) {
	signiso("$jobdir/$signfile", @signargs);
	next;
      }
      my @signmode;
      @signmode = ('-r') if $signfile =~ /\.drpm$/;
      if ($signfile =~ /\.asc$/s) {
	next unless (-s "$jobdir/$signfile") == 2048;
	my $signfilec = readstr("$jobdir/$signfile");
	next if substr($signfilec, 0, 8) ne "sIGnMe!\n";
	@signmode = ('-d');
	$signfile =~ s/\.asc$//s;
      }
      if (system($BSConfig::sign, @signargs, @signmode, "$jobdir/$signfile")) {
        unlink("$uploaddir/signer.$$") if $signkey;
	close F;
	if ($signfile =~ /\.rpm$/) {
	  print("sign failed: $? - checking digest\n");
	  if (system('rpm', '--checksig', '--nosignature', "$jobdir/$signfile")) {
	    print("rpm checksig failed: $? - restarting job\n");
	    BSUtil::cleandir($jobdir);
	    rmdir($jobdir);
	    unlink("$jobsdir/$arch/$job:status");
	    close F;
	    return undef;
	  }
	}
	die("sign $jobdir/$signfile failed\n");
      }
    }
    unlink("$uploaddir/signer.$$") if $signkey;

    # we have changed the file ids, thus we need to re-create
    # the .bininfo file
    my $bininfo = {};
    for my $file (@files) {
      next unless $file =~ /\.(?:rpm|deb)$/;
      my @s = stat("$jobdir/$file");
      next unless @s;
      my $id = "$s[9]/$s[7]/$s[1]";
      my $data = Build::query("$jobdir/$file", 'evra' => 1);
      eval {
        BSVerify::verify_nevraquery($data);
      };
      die("$jobdir/$file: $@") if $@;
      $bininfo->{$id} = $data;
    }
    Storable::nstore($bininfo, "$jobdir/.bininfo") if %$bininfo;
  }
  
  # write finished job status and release lock
  $jobstatus->{'code'} = 'finished';
  writexml("$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus);
  close F;

  unlink("$jobdir/.kiwitree_tosign");

  return 1;
}

sub ping {
  my ($arch) = @_;
  local *F;
  if (sysopen(F, "$eventdir/$arch/.ping", POSIX::O_WRONLY|POSIX::O_NONBLOCK)) {
    syswrite(F, 'x');
    close(F);
  }
}

sub signevent {
  my ($event, $ev) = @_;

  rename("$myeventdir/$event", "$myeventdir/${event}::inprogress");
  my $job = $ev->{'job'};
  my $arch = $ev->{'arch'};
  my $res;
  eval {
    $res = signjob($job, $arch);
  };
  if ($@) {
    warn("sign failed: $@");
    rename("$myeventdir/${event}::inprogress", "$myeventdir/$event");
    return;
  } elsif ($res) {
    my $name = $ev->{'type'} eq 'built' ? 'finished' : $ev->{'type'};
    writexml("$eventdir/$arch/.${name}:$job$$", "$eventdir/$arch/${name}:$job", $ev, $BSXML::event);
    ping($arch);
  }
  unlink("$myeventdir/${event}::inprogress");
}

$| = 1;
$SIG{'PIPE'} = 'IGNORE';
BSUtil::restartexit($ARGV[0], 'signer', "$rundir/bs_signer", "$myeventdir/.ping");
print "starting build service signer\n";

# get lock
mkdir_p($rundir);
open(RUNLOCK, '>>', "$rundir/bs_signer.lock") || die("$rundir/bs_signer.lock: $!\n");
flock(RUNLOCK, LOCK_EX | LOCK_NB) || die("signer is already running!\n");
utime undef, undef, "$rundir/bs_signer.lock";

die("sign program is not configured!\n") unless $BSConfig::sign;

mkdir_p($myeventdir);
if (!-p "$myeventdir/.ping") {
  POSIX::mkfifo("$myeventdir/.ping", 0666) || die("$myeventdir/.ping: $!");
  chmod(0666, "$myeventdir/.ping");
}
sysopen(PING, "$myeventdir/.ping", POSIX::O_RDWR) || die("$myeventdir/.ping: $!");

for my $event (grep {s/::inprogress$//s} ls($myeventdir)) {
  rename("$myeventdir/${event}::inprogress", "$myeventdir/$event");
}

my %chld;
my $pid;

while (1) {
  # drain ping pipe
  my $dummy;
  fcntl(PING,F_SETFL,POSIX::O_NONBLOCK);
  1 while (sysread(PING, $dummy, 1024, 0) || 0) > 0; 
  fcntl(PING,F_SETFL,0);

  my @events = ls($myeventdir);
  @events = grep {!/^\./} @events;

  for my $event (@events) {
    last if -e "$rundir/bs_signer.exit";
    last if -e "$rundir/bs_signer.restart";

    my $ev = readxml("$myeventdir/$event", $BSXML::event, 1);
    if (!$ev) {
      unlink("$myeventdir/$event");
      next;
    }
    if ($ev->{'type'} ne 'built' && $ev->{'type'} ne 'uploadbuild') {
      print "unknown event type: $ev->{'type'}\n";
      unlink("$myeventdir/$event");
      next;
    }
    if (!$maxchild || $maxchild == 1) {
      signevent($event, $ev);
      next;
    }
    if (!($pid = xfork())) {
      signevent($event, $ev);
      exit(0);
    }
    $chld{$pid} = 1;
    while (($pid = waitpid(-1, defined($maxchild) && keys(%chld) > $maxchild ? 0 : POSIX::WNOHANG)) > 0) {
      delete $chld{$pid};
    }
  }

  if (%chld) {
    while (($pid = waitpid(-1, 0)) > 0) {
      delete $chld{$pid};
    }   
  }

  if (-e "$rundir/bs_signer.exit") {
    unlink("$rundir/bs_signer.exit");
    print "exiting...\n";
    exit(0);
  }
  if (-e "$rundir/bs_signer.restart") {
    unlink("$rundir/bs_signer.restart");
    print "restarting...\n";
    exec($0);
    die("$0: $!\n");
  }
  print "waiting for an event...\n";
  sysread(PING, $dummy, 1, 0);
}
