#!/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;

BSUtil::set_fdatasync_before_rename() unless $BSConfig::disable_data_sync || $BSConfig::disable_data_sync;

my $tempdir = $BSConfig::servicetempdir || $BSConfig::servicetempdir || "/var/tmp";
my $port = 5152;
$port = $1 if $BSConfig::serviceserver =~ /:(\d+)$/;
my $silent;

my $servicedir = $BSConfig::servicedir;
$servicedir="/usr/lib/obs/service" unless $servicedir;
my $rootservicedir = $servicedir;
$rootservicedir = $BSConfig::serviceroot."/".$servicedir if $BSConfig::serviceroot;

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

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

       --tempdir   : temp dir 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' || $argv[0] eq '--tempdir') {
    shift @argv;
    $tempdir = shift @argv;
    next;
  }
  if ($argv[0] eq '--port') {
    shift @argv;
    $port = shift @argv;
    next;
  }
  last;
}

usage(1) unless $tempdir;

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

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

  my $myworkdir = $tempdir."/".$$;
  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" || -e "_serviceproject";

  # move all files from former service run to '.old'
  # so that they're available for services
  mkdir_p($myworkdir."/.old");
  for my $file (grep {/^_service[:_]/} ls(".")) {
    print "moving old file ".$file." to .old\n";
    rename($file,".old/".$file);
  }

  # set environment
  $::ENV{'OBS_SERVICE_PROJECT'} = $projid;
  $::ENV{'OBS_SERVICE_PACKAGE'} = $packid;

  # run all services
  mkdir_p($myworkdir."/.tmp");
  for my $sf ('_service', '_serviceproject') {
    next unless -e $sf;
    my $infoxml = readstr($sf);
    my $serviceinfo = XMLin($BSXML::services, $infoxml);
    for my $service (@{$serviceinfo->{'service'}}) {
      if (defined($service->{'mode'}) && ($service->{'mode'} eq 'localonly' || $service->{'mode'} eq 'disabled')) {
        print "Skip ".$service->{'name'}."\n";
        next;
      }
      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, "$servicedir/$service->{'name'}";
      for my $param (@{$service->{'param'}}) {
        next if $param->{'name'} eq 'outdir';
        next unless $param->{'_content'};
        push @run, "--$param->{'name'}";
        push @run, $param->{'_content'};
      }
      push @run, "--outdir";
      push @run, "$myworkdir/.tmp";
      BSUtil::cleandir("$myworkdir/.tmp");
    
      if (!open(SERVICE, '-|')) {
        open(STDERR, ">&STDOUT");
        exec(@run);
        die("$run[0]: $!\n");
      }
    
      my $output = "";
      while (<SERVICE>) {
        $output .= $_;
      }
    
      if (close SERVICE) {
        # SUCCESS, copy files inside and add prefix
        for my $file (grep {!/^[:\.]/} ls("$myworkdir/.tmp")) {
          my $mode = (stat("$myworkdir/.tmp/$file"))[2];
          if (!S_ISDIR($mode)) {
            my $tfile = "_service:".$service->{'name'}.":".$file;
            rename("$myworkdir/.tmp/".$file, $tfile);
          }
        }
      } else { 
        # FAILURE, Create error file
        BSUtil::cleandir(".");
        local *F;
        if (open(F, '>>', "_service_error")) {
           print F "service $service->{'name'} failed:\n";
           print F $output;
           close F;
        }
        last;
      }
    }
  }
  BSUtil::cleandir("$myworkdir/.tmp");
  rmdir("$myworkdir/.tmp");

  # remove old files (from former service run)
  BSUtil::cleandir("$myworkdir/.old");
  rmdir("$myworkdir/.old");

  # get all generate files
  my @send = map {{'name' => $_, 'filename' => "$_"}} grep {/^_service[_:]/} ls(".");

  # check for non files (symlinks or directories)
  for my $file (@send) {
    die("Service result contains unreadable file '$file->{'filename'}'\n") unless -f $file->{'filename'};
  }

  # send everything back for real
  BSServer::reply_cpio(\@send);
  
  # clean up
  BSUtil::cleandir($myworkdir);
  rmdir($myworkdir);
}

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

sub show_service {
  my ($cgi) = @_;
}

sub list_service {
  my ($cgi) = @_;

  my $servicelist = {};
  my @sl;
  
  for my $servicefile (ls($rootservicedir)){
     next unless $servicefile =~ /.service$/;
     my $service = readxml($rootservicedir."/".$servicefile, $BSXML::servicetype, 1);
     next unless $service;
     next unless $service->{'name'};
     next unless -x "$rootservicedir/$service->{'name'}";
     push @sl, $service;
  }

  $servicelist->{'service'} = \@sl;

  return ($servicelist, $BSXML::servicelist); 
}

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

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

  '/service' => \&list_service,
#  '/service/$service' => \&show_service,
  '!- POST:/sourceupdate/$project/$package' => \&run_source_update,
];

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

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