#!/usr/bin/perl -w
#
# Copyright (c) 2009 Adrian Schroeter, Novell Inc.
# Copyright (c) 2006-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
#
################################################################
#
# Worker build process. Builds jobs received from a Repository Server,
# sends build binary packages back.
#

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

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

use BSRPC;
use BSServer;
use BSStdServer;
use BSConfig;
use BSUtil;
use BSXML;
use BSHTTP;
use BSBuild;

use strict;

undef $BSConfig::bsuser;	# need to stay root
undef $BSConfig::bsgroup;

my $buildroot;
my $port = 5152;
my $silent;

my $gettimeout = 3600; # 1 hour timeout to avoid forever hanging workers

sub usage {
  my ($ret) = @_;

print <<EOF;
Usage: $0 [OPTION] [--root <directory>]

       --root      : buildroot directory (switches to daemon mode)

       --port      : fixed port number

       --process   : just run the services, don't send anything back
                     (needs a service job file as argument)

       --help      : this message

EOF
  exit $ret || 0;
}

my @argv = @ARGV;	# need to make copy for restart feature
while (@argv) {
  usage(0) if $argv[0] eq '--help';
  exit 0 if $argv[0] eq '--test'; # just for self-startup test
  if ($argv[0] eq '--root') {
    shift @argv;
    $buildroot = shift @argv;
    next;
  }
  if ($argv[0] eq '--port') {
    shift @argv;
    $port = shift @argv;
    next;
  }
  last;
}

usage(1) unless $buildroot;

sub rm_rf {
  my ($dir) = @_;
  BSUtil::cleandir($dir);
  rmdir($dir);
}

sub qsystem {
  my (@args) = @_;
  if ($silent) {
    my $pid;
    if (!($pid = xfork())) {
      open(STDOUT, ">/dev/null");
      exec(@args);
      die("$args[0]: $!\n"); 
    }
    waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n"); 
    return $?;
  } else {
    return system @args;
  }
}

sub run_source_update {
  my ($cgi, $projid, $packid) = @_;

  my $myworkdir = $buildroot."/".$$;
  BSUtil::cleandir($myworkdir);
  mkdir_p($myworkdir);
  die("$myworkdir not writable for me") unless -w $myworkdir;
  chdir($myworkdir) || die("$myworkdir: $!\n");

  # unpack source data
  my $uploaded = BSServer::read_cpio($myworkdir);

  die("no _service file !") unless -e "_service";

  # remove all files from former service run
  my @oldfiles;
  for my $file (grep {/^_service[:_]/} ls(".")) {
    print "remove ".$file."\n";
    unlink( $file );
    push @oldfiles, $file;
  }

  # run all services
  mkdir_p($myworkdir."/.tmp");
  my $infoxml = readstr('_service');
  my $serviceinfo = XMLin($BSXML::services, $infoxml);
  for my $service (@{$serviceinfo->{'service'}}) {
    print "Run for ".$service->{'name'}."\n";
    my @run;
    if (defined $BSConfig::service_wrapper{$service->{'name'}} ) {
      push @run, $BSConfig::service_wrapper{$service->{'name'}};
    } else {
      if (defined $BSConfig::service_wrapper{'*'}) {
        push @run, $BSConfig::service_wrapper{'*'};
      }
    }
    push @run, $BSConfig::servicedir."/".$service->{'name'};
    push @run, "--outdir";
    push @run, $myworkdir."/.tmp";
    for my $param (@{$service->{'param'}}) {
      push @run, "--".$param->{'name'};
      push @run, $param->{'_content'};
    }
    BSUtil::cleandir($myworkdir."/.tmp");
    if (qsystem(@run)) {
      BSUtil::cleandir(".");
     
      # Create error file
      local *F;
      if (open(F, '>>', "_service_error")) {
         print F "service ".$service->{'name'}." ".join(' ',@run)." failed\n";
         close F;
      }
      last;
    } else { 
      # copy files inside and add prefix
      for my $file (grep {!/^[:\.]/} ls($myworkdir."/.tmp")) {
        my $tfile = "_service:".$service->{'name'}.":".$file;
        rename( $myworkdir."/.tmp/".$file, $tfile );
        @oldfiles = grep(!/$tfile$/, @oldfiles);
      }
    }
  }
  BSUtil::cleandir($myworkdir."/.tmp");
  rmdir($myworkdir."/.tmp");

  # return modified sources
  my @send = map {{'name' => $_, 'filename' => "$_"}} grep {/^_service[_:]/} ls(".");
  BSServer::reply_cpio(\@send);
  
  # clean up
  BSUtil::cleandir($myworkdir);
  rmdir($myworkdir);
}

sub hello {
  my ($cgi) = @_;
  return "<hello name=\"Source Service Server\" />\n";
}

# define server
my $dispatches = [
  '/' => \&hello,

  '!rw :' => undef,
  '!- GET:' => undef,
  '!- HEAD:' => undef,

  'POST:/sourceupdate/$project/$package' => \&run_source_update,
];

my $conf = {
  'port' => $port,
  'dispatches' => $dispatches,
  'setkeepalive' => 1,
#  'maxchild' => 20,
};

BSStdServer::server('bs_service', \@ARGV, $conf);
