enforce outdir parameter
[opensuse:build-service.git] / src / backend / bs_service
1 #!/usr/bin/perl -w
2 #
3 # Copyright (c) 2009 Adrian Schroeter, Novell Inc.
4 # Copyright (c) 2006-2009 Michael Schroeder, Novell Inc.
5 #
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License version 2 as
8 # published by the Free Software Foundation.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program (see the file COPYING); if not, write to the
17 # Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
19 #
20 ################################################################
21 #
22 # Worker build process. Builds jobs received from a Repository Server,
23 # sends build binary packages back.
24 #
25
26 BEGIN {
27   my ($wd) = $0 =~ m-(.*)/- ;
28   $wd ||= '.';
29   unshift @INC,  "$wd/build";
30   unshift @INC,  "$wd";
31 }
32
33 use Digest::MD5 ();
34 use XML::Structured ':bytes';
35 use Data::Dumper;
36 use POSIX;
37 use Fcntl qw(:DEFAULT :flock);
38
39 use BSRPC;
40 use BSServer;
41 use BSStdServer;
42 use BSConfig;
43 use BSUtil;
44 use BSXML;
45 use BSHTTP;
46 use BSBuild;
47
48 use strict;
49
50 undef $BSConfig::bsuser;        # need to stay root
51 undef $BSConfig::bsgroup;
52
53 my $buildroot;
54 my $port = 5152;
55 my $silent;
56
57 my $servicedir = $BSConfig::servicedir;
58 $servicedir="/usr/lib/obs/service" unless $servicedir;
59
60 my $gettimeout = 3600; # 1 hour timeout to avoid forever hanging workers
61
62 sub usage {
63   my ($ret) = @_;
64
65 print <<EOF;
66 Usage: $0 [OPTION] [--root <directory>]
67
68        --root      : buildroot directory (switches to daemon mode)
69
70        --port      : fixed port number
71
72        --process   : just run the services, don't send anything back
73                      (needs a service job file as argument)
74
75        --help      : this message
76
77 EOF
78   exit $ret || 0;
79 }
80
81 my @argv = @ARGV;       # need to make copy for restart feature
82 while (@argv) {
83   usage(0) if $argv[0] eq '--help';
84   exit 0 if $argv[0] eq '--test'; # just for self-startup test
85   if ($argv[0] eq '--root') {
86     shift @argv;
87     $buildroot = shift @argv;
88     next;
89   }
90   if ($argv[0] eq '--port') {
91     shift @argv;
92     $port = shift @argv;
93     next;
94   }
95   last;
96 }
97
98 usage(1) unless $buildroot;
99
100 sub rm_rf {
101   my ($dir) = @_;
102   BSUtil::cleandir($dir);
103   rmdir($dir);
104 }
105
106 sub qsystem {
107   my (@args) = @_;
108   if ($silent) {
109     my $pid;
110     if (!($pid = xfork())) {
111       open(STDOUT, ">/dev/null");
112       exec(@args);
113       die("$args[0]: $!\n"); 
114     }
115     waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n"); 
116     return $?;
117   } else {
118     return system @args;
119   }
120 }
121
122 sub run_source_update {
123   my ($cgi, $projid, $packid) = @_;
124
125   my $myworkdir = $buildroot."/".$$;
126   BSUtil::cleandir($myworkdir);
127   mkdir_p($myworkdir);
128   die("$myworkdir not writable for me") unless -w $myworkdir;
129   chdir($myworkdir) || die("$myworkdir: $!\n");
130
131   # unpack source data
132   my $uploaded = BSServer::read_cpio($myworkdir);
133
134   die("no _service file !") unless -e "_service";
135
136   # remove all files from former service run
137   my @oldfiles;
138   for my $file (grep {/^_service[:_]/} ls(".")) {
139     print "remove ".$file."\n";
140     unlink( $file );
141     push @oldfiles, $file;
142   }
143
144   # run all services
145   mkdir_p($myworkdir."/.tmp");
146   my $infoxml = readstr('_service');
147   my $serviceinfo = XMLin($BSXML::services, $infoxml);
148   for my $service (@{$serviceinfo->{'service'}}) {
149     print "Run for ".$service->{'name'}."\n";
150     my @run;
151     if (defined $BSConfig::service_wrapper->{$service->{'name'}} ) {
152       push @run, $BSConfig::service_wrapper->{$service->{'name'}};
153     } else {
154       if (defined $BSConfig::service_wrapper->{'*'}) {
155         push @run, $BSConfig::service_wrapper->{'*'};
156       }
157     }
158     push @run, $servicedir."/".$service->{'name'};
159     push @run, $myworkdir."/.tmp";
160     for my $param (@{$service->{'param'}}) {
161       next if $param->{'name'} eq 'outdir';
162       push @run, "--".$param->{'name'};
163       push @run, $param->{'_content'};
164     }
165     push @run, "--outdir";
166     BSUtil::cleandir($myworkdir."/.tmp");
167     if (qsystem(@run)) {
168       BSUtil::cleandir(".");
169      
170       # Create error file
171       local *F;
172       if (open(F, '>>', "_service_error")) {
173          print F "service ".$service->{'name'}." ".join(' ',@run)." failed\n";
174          close F;
175       }
176       last;
177     } else { 
178       # copy files inside and add prefix
179       for my $file (grep {!/^[:\.]/} ls($myworkdir."/.tmp")) {
180         my $tfile = "_service:".$service->{'name'}.":".$file;
181         rename( $myworkdir."/.tmp/".$file, $tfile );
182         @oldfiles = grep(!/$tfile$/, @oldfiles);
183       }
184     }
185   }
186   BSUtil::cleandir($myworkdir."/.tmp");
187   rmdir($myworkdir."/.tmp");
188
189   # return modified sources
190   my @send = map {{'name' => $_, 'filename' => "$_"}} grep {/^_service[_:]/} ls(".");
191   BSServer::reply_cpio(\@send);
192   
193   # clean up
194   BSUtil::cleandir($myworkdir);
195   rmdir($myworkdir);
196 }
197
198 sub hello {
199   my ($cgi) = @_;
200   return "<hello name=\"Source Service Server\" />\n";
201 }
202
203 # define server
204 my $dispatches = [
205   '/' => \&hello,
206
207   '!rw :' => undef,
208   '!- GET:' => undef,
209   '!- HEAD:' => undef,
210
211   'POST:/sourceupdate/$project/$package' => \&run_source_update,
212 ];
213
214 my $conf = {
215   'port' => $port,
216   'dispatches' => $dispatches,
217   'setkeepalive' => 1,
218 #  'maxchild' => 20,
219 };
220
221 BSStdServer::server('bs_service', \@ARGV, $conf);