#!/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
#
################################################################
#
# Source service process. Processes package and project _service
# files.
#

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

use XML::Structured ':bytes';
use Digest::MD5 ();
use Data::Dumper;

use BSConfiguration;
use BSServer;
use BSStdServer;
use BSUtil;
use BSXML;

use strict;

no warnings "once";

$BSConfig::bsuser  = $BSConfig::bsserviceuser;
$BSConfig::bsgroup = $BSConfig::bsservicegroup;
$BSConfig::bsdir   = "$BSConfig::bsdir/service";
$BSConfig::logdir  = "$BSConfig::bsdir/log";
$BSConfig::rundir  = "$BSConfig::bsdir/run";

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


my $tempdir = $BSConfig::servicetempdir;
my $verbose;
my $port = 5152;
my $proto = 'http';
$port = $1 if $BSConfig::serviceserver =~ /:(\d+)$/;
$proto = $1 if $BSConfig::serviceserver =~ /^(https):/;

my $servicedir = $BSConfig::servicedir || "/usr/lib/obs/service";
my $rootservicedir = $BSConfig::serviceroot ? "$BSConfig::serviceroot/$servicedir" : $servicedir;
my $uploaddir = "$BSConfig::bsdir/upload";

my $proxy = $BSConfig::proxy;
my $noproxy = $BSConfig::noproxy;
my $maxchild = $BSConfig::service_maxchild;

my $servicedef_obs_scm_bridge = {
  'name' => 'obs_scm_bridge',
  'parameter' => [
    {
      'name' => 'url' ,
      'description' => 'Specify URL to checkout.',
      'required' => undef,
    },
    {
      'name' => 'projectmode' ,
      'description' => 'Run a project update.',
    },
    {
      'name' => 'projectscmsync' ,
      'description' => 'scmsync url from project level',
    }
  ],
};

use warnings;

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

print <<EOF;
Usage: $0 [OPTION]

       --port      : Port to listen for connections

       --verbose   : Print output of services

       --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 '--port') {
    shift @argv;
    $port = shift @argv;
    next;
  }
  if ($argv[0] eq '--verbose' || $argv[0] eq '-v') {
    $verbose = 1;
    shift @argv;
    next;
  }
  last;
}

sub rm_rf {
  my ($dir) = @_;
  unlink($dir);		# just in case this is a symlink
  BSUtil::cleandir($dir);
  rmdir($dir);
}

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

  my $noprefix = $cgi->{'noprefix'};

  # just as fallback for older servicedispatchers
  $timeout ||= $BSConfig::service_timeout;

  # chdir into a clean temp directory
  my $myworkdir = "$tempdir/$$";
  rm_rf($myworkdir);
  die("500 cannot get rid of old work dir\n") if -e $myworkdir;
  mkdir_p("$myworkdir/src") || die("mkdir $myworkdir/src: $!\n");
  chdir("$myworkdir/src") || die("chdir $myworkdir/src: $!\n");

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

  die("no _service file in sources!\n") unless -e "_service" || -e "_serviceproject";

  # move all files from former service run to '.old'
  # so that they're available for services
  mkdir_p('.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;
  $::ENV{'OBS_SERVICE_APIURL'} = $BSConfig::api_url if $BSConfig::api_url;
  $::ENV{'OBS_NAME'} = $BSConfig::obsname if $BSConfig::obsname;
  $::ENV{'OBS_SERVICE_DAEMON'} = 1;
  $::ENV{'no_proxy'} = $noproxy if $noproxy;
  $::ENV{'http_proxy'} = $proxy if $proxy;
  $::ENV{'https_proxy'} = $proxy if $proxy;

  # collect services to run
  my @services;
  for my $sf ('_service', '_serviceproject') {
    next unless -e $sf;
    my $serviceinfo = readxml($sf, $BSXML::services);
    for my $service (@{$serviceinfo->{'service'}}) {
      my $name = $service->{'name'};
      BSVerify::verify_filename($name);
      if (defined($service->{'mode'}) && ($service->{'mode'} eq 'localonly' || $service->{'mode'} eq 'disabled' || $service->{'mode'} eq 'manual' || $service->{'mode'} eq 'buildtime')) {
        print "Skip $name\n";
      } else {
        print "Take $name\n";
        push @services, $service;
      }
    }
  }

  BSUtil::cleandir('.') if $noprefix && !@services;	# hmm?

  # now run all services
  my $error;
  for my $service (@services) {
    my $name = $service->{'name'};
    BSUtil::printlog("Run for $name");
    my $servicedef;
    if ($name eq 'obs_scm_bridge') {
      $servicedef = $servicedef_obs_scm_bridge;
    } else {
      $servicedef = readxml("$rootservicedir/$name.service", $BSXML::servicetype);
    }
    my @run;
    if (defined $BSConfig::service_wrapper->{$name} ) {
      push @run, $BSConfig::service_wrapper->{$name};
    } elsif (defined $BSConfig::service_wrapper->{'*'}) {
      push @run, $BSConfig::service_wrapper->{'*'};
    }
    push @run, "$servicedir/$name";
    for my $param (@{$service->{'param'}}) {
      next if $param->{'name'} eq 'outdir';
      next unless $param->{'_content'};
      die("$name: service parameter \"$param->{'name'}\" is not defined\n") unless grep {$_->{'name'} eq $param->{'name'}} @{$servicedef->{'parameter'}};
      push @run, "--$param->{'name'}";
      push @run, $param->{'_content'};
    }
    push @run, "--outdir";
    push @run, "$myworkdir/out";

    mkdir("$myworkdir/out") || die("mkdir $myworkdir/out: $!\n");

    BSUtil::printlog("Running command '@run'");
    # call the service
    my $child_pid = open(SERVICE, '-|');
    die "500 Unable to open pipe: $!\n" unless defined($child_pid);
    if (! $child_pid) {
      open(STDERR, ">&STDOUT");
      exec(@run);
      die("$run[0]: $!\n");
    }

    local $SIG{ALRM} = sub {
      kill 'TERM', $child_pid;
      die "500 timeout while execution of $name\n";
    };

    # Wait given timeout or $BSConfig::service_timeout for service to finish
    BSUtil::printlog("Waiting $timeout for service($child_pid) to finish\n") if $verbose;
    alarm($timeout);

    # collect output
    my $output = '';
    $output .= $_ while <SERVICE>;

    BSUtil::printlog(" $name: $output") if $verbose;

    if (close SERVICE) {
      # SUCCESS, move files inside and add prefix
      BSUtil::printlog('Service succeed') if $verbose;
      BSUtil::cleandir('.') if $noprefix;
      for my $file (grep {!/^[:\.]/} sort(ls("$myworkdir/out"))) {
	next if -l "$myworkdir/out/$file" || ! -f _;	# only plain files for now
	my $tfile = $file;
	if (!$noprefix) {
	  $tfile =~ s/^_service://s;
	  $tfile = "_service:$name:$tfile";
	}
	rename("$myworkdir/out/$file", $tfile) || die("rename $myworkdir/out/$file $tfile: $!\n");
      }
    } else { 
      # FAILURE, Create error file
      BSUtil::printlog("Service failed: $!") if $verbose;
      $output =~ s/[\r\n\s]+$//s;
      BSUtil::cleandir('.');
      die("500 remote execution error in $name detected\n") if $? >> 8 == 3;
      BSUtil::writestr('_service_error', undef, "service $name failed:\n$output\n");
      $error = 1;
    }

    alarm(0);

    # delete no longer needed outdir
    rm_rf("$myworkdir/out");

    last if $error;
  }

  # remove old files (from former service run)
  rm_rf('.old');

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

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

  # send everything back for real
  BSServer::reply_cpio(\@send);
  
  # clean up
  rm_rf($myworkdir);

  return undef;	# already replied
}

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

sub list_service {
  my ($cgi) = @_;
  my @sl;
  for my $servicefile (grep {/\.service$/} ls($rootservicedir)) {
     my $service = readxml("$rootservicedir/$servicefile", $BSXML::servicetype, 1);
     next unless $service && $service->{'name'};
     push @sl, $service;
  }
  return ({'service' => \@sl}, $BSXML::servicelist); 
}

sub putconfiguration {
  my ($cgi) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $configurationxml = readstr("$uploaddir/$$");
  unlink("$uploaddir/$$");
  my $oldconfigurationxml = readstr("$BSConfig::bsdir/configuration.xml", 1);
  if ($configurationxml ne ($oldconfigurationxml || '')) {
    BSUtil::fromxml($configurationxml, $BSXML::configuration);	# test xml syntax
    writestr("$BSConfig::bsdir/.configuration.xml", "$BSConfig::bsdir/configuration.xml", $configurationxml);
  }
  return $BSStdServer::return_ok;
}

BSUtil::mkdir_p_chown($tempdir, $BSConfig::bsuser, $BSConfig::bsgroup);

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

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

  '/service' => \&list_service,
  '/serverstatus' => \&BSStdServer::serverstatus,
  '!- POST:/sourceupdate/$project/$package $timeout:num? noprefix:bool?' => \&run_source_update,
  # configuration
  'PUT:/configuration' => \&putconfiguration,
];

my $conf = {
  'runname' => 'bs_service',
  'port' => $port,
  'proto' => $proto,
  'dispatches' => $dispatches,
  'setkeepalive' => 1,
  'maxchild' => $maxchild,
};
%$conf = (%$conf, %{$BSConfig::serviceserver_extraconf}) if $BSConfig::serviceserver_extraconf;

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