Kleine Fixes am Pakfire - brauche Binary.
[people/pmueller/ipfire-2.x.git] / src / pakfire / lib / functions.pl
CommitLineData
1bd42c89
MT
1#!/usr/bin/perl -w
2
3require "/opt/pakfire/etc/pakfire.conf";
4
5use File::Basename;
6use File::Copy;
7use LWP::UserAgent;
4d504812 8use HTTP::Response;
1bd42c89
MT
9use Net::Ping;
10
11package Pakfire;
12
13sub message {
14 my $message = shift;
15 print "$message\n";
16 logger("$message");
17}
18
19sub logger {
20 my $log = shift;
21 system("logger -t pakfire \"$log\"");
22}
23
24sub pinghost {
25 my $host = shift;
26
27 $p = Net::Ping->new();
28 if ($p->ping($host)) {
29 logger("$host is alive.");
30 return 1;
31 } else {
32 logger("$host is dead.");
33 return 0;
34 }
35 $p->close();
36}
37
38sub fetchfile {
4d504812
MT
39 my $getfile = shift;
40 my $gethost = shift;
41 my (@server, $host, $proto, $file, $allok, $i);
1bd42c89
MT
42
43 use File::Basename;
4d504812 44 $bfile = basename("$getfile");
1bd42c89 45
4d504812
MT
46 $i = 0;
47 while (($allok == 0) && $i < 5) {
48 $i++;
49
50 if ("$gethost" eq "") {
51 @server = selectmirror();
52 $proto = $server[0];
53 $host = $server[1];
54 $file = "$server[2]/$getfile";
1bd42c89 55 } else {
4d504812 56 $host = $gethost;
afabe9f7 57 $file = $getfile;
1bd42c89 58 }
4d504812
MT
59
60 $proto = "HTTP" unless $proto;
61
62 logger("Trying to get $file from $host ($proto).");
1bd42c89 63
4d504812
MT
64 my $ua = LWP::UserAgent->new;
65 $ua->agent("Pakfire/$Conf::version");
afabe9f7 66 $ua->timeout(5);
4d504812
MT
67 #$ua->env_proxy;
68
69 my $response = $ua->get("http://$host/$file");
70
71 if ($response->is_success) {
72 logger("$host sends file: $file.");
73 if (open(FILE, ">$Conf::cachedir/$bfile")) {
74 print FILE $response->content;
75 close(FILE);
76 $allok = 1;
77 return 0;
78 } else {
79 logger("Could not open $Conf::cachedir/$bfile for writing.");
80 }
81 } else {
82 my $log = $response->status_line;
83 logger("Download $file failed from $host ($proto): $log");
84 }
1bd42c89 85 }
4d504812
MT
86 message("Giving up: There was no chance to get the file \"$getfile\" from any available server.\nMay be you should run \"pakfire update\" to get some new servers.");
87 return 1;
1bd42c89
MT
88}
89
90sub getmirrors {
91 use File::Copy;
92
93 logger("Try to get a mirror list.");
94
95 fetchfile("lists/$Conf::version-server-list", "$Conf::mainserver");
96 move("$Conf::cachedir/$Conf::version-server-list", "$Conf::dbdir/lists/$Conf::version-server-list");
97}
98
99sub selectmirror {
100 ### Check if there is a current server list and read it.
101 # If there is no list try to get one.
102 my $count = 0;
103 while (!(open(FILE, "<$Conf::dbdir/lists/$Conf::version-server-list")) && ($count lt 5)) {
104 $count++;
105 getmirrors();
106 }
107 if ($count == 5) {
108 message("Could not find or download a server list.");
109 exit 1;
110 }
111 my @lines = <FILE>;
112 close(FILE);
113
114 ### Count the number of the servers in the list
115 my $scount = 0;
116 foreach (@lines) {
117 $scount++;
118 }
119 logger("$scount servers found in list.");
120
121 ### Choose a random server and test if it is online
122 # If the check fails try a new server.
123 # This will never give up.
124 my $found = 0;
125 my $servers = 0;
126 while ($found == 0) {
127 $server = int(rand($scount) + 1);
128 $servers = 0;
129 my ($line, $proto, $path, $host);
130 my @templine;
131 foreach $line (@lines) {
132 $servers++;
133 if ($servers eq $server) {
134 @templine = split(/\;/, $line);
135 $proto = $templine[0];
136 $host = $templine[1];
137 $path = $templine[2];
a08c3a2e 138 if (pinghost("$host")) {
1bd42c89
MT
139 $found = 1;
140 return ($proto, $host, $path);
141 }
142 }
143 }
4d504812 144 }
1bd42c89
MT
145}
146
147sub dbgetlist {
148 ### Update the database if the file is older than one day.
149 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
150 # Usage is always with an argument.
151 my $force = shift;
152 my $age;
153
154 use File::Copy;
155
156 if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
157 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
158 my $time = time();
159 $age = $time - $stat[9];
160 } else {
161 # Force an update.
162 $age = "86401";
163 }
164
165 if (("$age" gt 86400) || ("$force" eq "force")) {
166 cleanup();
167 fetchfile("lists/packages_list.db", "");
168 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
169 }
170}
171
172sub dblist {
173 ### This subroutine lists the packages.
174 # You may also pass a filter: &Pakfire::dblist(filter)
175 # Usage is always with two arguments.
176 # filter may be: all, notinstalled, installed
177 my $filter = shift;
178 my $forweb = shift;
179
180 ### Make sure that the list is not outdated.
181 dbgetlist("noforce");
182
183 open(FILE, "<$Conf::dbdir/lists/packages_list.db");
184 my @db = <FILE>;
185 close(FILE);
186
187 my $line;
188 my @templine;
189 foreach $line (sort @db) {
190 @templine = split(/\;/,$line);
191 ### filter here...
192 if ("$forweb" eq "forweb") {
afabe9f7 193 print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
1bd42c89 194 } else {
afabe9f7 195 print "Name: $templine[0]\nVersion: $templine[1]\nRelease: $templine[2]\n\n";
1bd42c89
MT
196 }
197 }
198}
199
200sub resolvedeps {
201 my $pak = shift;
202
203 getmetafile("$pak");
204
205 message("\n## Resolving dependencies for $pak...");
206
207 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
208 my @file = <FILE>;
209 close(FILE);
210
211 my $line;
212 my (@templine, @deps, @tempdeps);
213 foreach $line (@file) {
214 @templine = split(/\: /,$line);
215 if ("$templine[0]" eq "Dependencies") {
216 @deps = split(/ /, $templine[1]);
217 }
218 }
219 chomp (@deps);
220 foreach (@deps) {
221 if ($_) {
222 message("### Found dependency: $_");
223 push(@tempdeps,$_);
224 }
225 }
226
227 #my @tempdeps = @deps;
228 foreach (@tempdeps) {
229 if ($_) {
230 my @newdeps = resolvedeps("$_");
231 foreach(@newdeps) {
232 unless (($_ eq " ") || ($_ eq "")) {
233 message("### Found dependency: $_");
234 push(@deps,$_);
235 }
236 }
237 }
238 }
239 chomp (@deps);
240 return @deps;
241}
242
243sub cleanup {
244 my $dir = shift;
245 my $path;
246
247 if ( "$dir" eq "meta" ) {
248 $path = "$Conf::dbdir/meta";
249 } elsif ( "$dir" eq "tmp" ) {
250 $path = "$Conf::tmpdir";
251 }
252 chdir("$path");
253 opendir(DIR,".");
254 my @files = readdir(DIR);
255 closedir(DIR);
256 foreach (@files) {
257 unless (($_ eq ".") || ($_ eq "..")) {
258 system("rm -rf $_");
259 }
260 }
261}
262
263sub getmetafile {
264 my $pak = shift;
265
266 logger("Going to download meta-$pak.");
267
268 unless ( -e "$Conf::dbdir/meta/meta-$pak") {
269 fetchfile("meta/meta-$pak", "");
270 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
271 }
272
273 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
274 my @line = <FILE>;
275 close(FILE);
276
277 open(FILE, ">$Conf::dbdir/meta/meta-$pak");
278 foreach (@line) {
279 my $string = $_;
280 $string =~ s/\r\n/\n/g;
281 print FILE $string;
282 }
283 close(FILE);
284 return 1;
285}
286
287sub getsize {
288 my $pak = shift;
289
290 getmetafile("$pak");
291
292 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
293 my @file = <FILE>;
294 close(FILE);
295
296 my $line;
297 my @templine;
298 foreach $line (@file) {
299 @templine = split(/\: /,$line);
300 if ("$templine[0]" eq "Size") {
301 chomp($templine[1]);
302 return $templine[1];
303 }
304 }
305}
306
a08c3a2e 307sub addsizes { ## Still not working
1bd42c89
MT
308 my @paks = shift;
309
a08c3a2e 310 my $paksize;
1bd42c89 311 my $totalsize = 0;
a08c3a2e
MT
312 foreach (@paks) {
313 $paksize = getsize("$_");
314 $totalsize = ($totalsize + $paksize) ;
1bd42c89
MT
315 }
316 return $totalsize;
317}
318
319sub decryptpak {
320 my $pak = shift;
321
322 cleanup("tmp");
323
324 my $file = getpak("$pak", "noforce");
325
326 my $return = system("gpg -d < $Conf::cachedir/$file | tar xj -C $Conf::tmpdir/");
327
328 logger("Decryption process returned the following: $return");
afabe9f7 329 if ($return != 1) { exit 1; }
1bd42c89
MT
330}
331
332sub getpak {
333 my $pak = shift;
334 my $force = shift;
335
336 getmetafile("$pak");
337
338 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
339 my @file = <FILE>;
340 close(FILE);
341
342 my $line;
343 my $file;
344 my @templine;
345 foreach $line (@file) {
346 @templine = split(/\: /,$line);
347 if ("$templine[0]" eq "File") {
348 chomp($templine[1]);
349 $file = $templine[1];
350 }
351 }
352
353 unless ($file) {
354 message("No filename given in meta-file. Please phone the developers.");
355 exit 1;
356 }
357
1bd42c89
MT
358 unless ( "$force" eq "force" ) {
359 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
360 return $file;
361 }
362 }
363
364 fetchfile("paks/$file", "");
365 return $file;
366}
367
368sub setuppak {
369 my $pak = shift;
370
371 message("We are going to install: $pak");
372
373 decryptpak("$pak");
374
375 my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
376 if ($return == 0) {
377 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
378 cleanup("tmp");
4d504812 379 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
1bd42c89
MT
380 message("Setup completed. Congratulations!");
381 } else {
382 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
383 exit $return;
384 }
a08c3a2e 385 return $return;
1bd42c89
MT
386}
387
388sub updatepak {
389 my $pak = shift;
390
391 message("We are going to update: $pak");
392
393 decryptpak("$pak");
394
395 my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
396 if ($return == 0) {
397 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
398 cleanup("tmp");
399 message("Update completed. Congratulations!");
400 } else {
401 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
402 exit $return;
403 }
8e58bd37 404 return $return;
1bd42c89
MT
405}
406
407sub removepak {
408 my $pak = shift;
409
410 message("We are going to uninstall: $pak");
411
412 decryptpak("$pak");
413
414 my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
415 if ($return == 0) {
416 open(FILE, "<$Conf::dbdir/rootfiles/$pak");
417 my @file = <FILE>;
418 close(FILE);
419 foreach (@file) {
420 my $line = $_;
421 chomp($line);
422 system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
423 system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
424 }
425 unlink("$Conf::dbdir/rootfiles/$pak");
426 cleanup("tmp");
427 message("Uninstall completed. Congratulations!");
428 } else {
429 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
430 exit $return;
431 }
8e58bd37 432 return $return;
1bd42c89
MT
433}
434
435sub beautifysize {
436 my $size = shift;
a08c3a2e
MT
437 $size = $size / 1024;
438 my $unit;
1bd42c89
MT
439
440 if ($size > 1023) {
a08c3a2e
MT
441 $size = ($size / 1024);
442 $unit = "MB";
1bd42c89 443 } else {
a08c3a2e 444 $unit = "KB";
1bd42c89 445 }
a08c3a2e
MT
446 $size = sprintf("%.2f" , $size);
447 my $string = "$size $unit";
448 return $string;
1bd42c89
MT
449}
450
8e58bd37
MT
451sub makeuuid {
452 unless ( -e "$Conf::dbdir/uuid" ) {
8e58bd37
MT
453 open(FILE, "</proc/sys/kernel/random/uuid");
454 my @line = <FILE>;
455 close(FILE);
456
457 open(FILE, ">$Conf::dbdir/uuid");
458 foreach (@line) {
459 print FILE $_;
460 }
461 close(FILE);
462 }
463}
464
465sub senduuid {
466 unless("$Conf::uuid") {
467 $Conf::uuid = `cat $Conf::dbdir/uuid`;
468 }
469 logger("Sending my uuid: $Conf::uuid");
470 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
4cb74dce 471 system("rm -f $Conf::cachedir/counter* 2>/dev/null");
8e58bd37 472}
1bd42c89
MT
473
4741;