Die Mindestgröße des Dateisystems nochmal reduziert für die Installation
[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";
4b122800 4require "/var/ipfire/general-functions.pl";
1bd42c89
MT
5
6use File::Basename;
7use File::Copy;
8use LWP::UserAgent;
4d504812 9use HTTP::Response;
1bd42c89
MT
10use Net::Ping;
11
12package Pakfire;
13
4b122800
MT
14my %pakfiresettings = ();
15&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
16
1bd42c89
MT
17sub message {
18 my $message = shift;
19 print "$message\n";
20 logger("$message");
21}
22
23sub logger {
24 my $log = shift;
25 system("logger -t pakfire \"$log\"");
26}
27
5b2a12ff
MT
28sub usage {
29 &Pakfire::message("Usage: pakfire <install|remove> <pak(s)>");
30 &Pakfire::message(" <update> - Contacts the servers for new lists of paks.");
99e6df8e 31 &Pakfire::message(" <upgrade> - Installs the latest version of all paks.");
5b2a12ff 32 &Pakfire::message(" <list> - Outputs a short list with all available paks.");
99e6df8e 33 &Pakfire::message("");
5b2a12ff
MT
34 exit 1;
35}
36
1bd42c89
MT
37sub pinghost {
38 my $host = shift;
39
40 $p = Net::Ping->new();
41 if ($p->ping($host)) {
42 logger("$host is alive.");
43 return 1;
44 } else {
45 logger("$host is dead.");
46 return 0;
47 }
48 $p->close();
49}
50
51sub fetchfile {
4d504812
MT
52 my $getfile = shift;
53 my $gethost = shift;
54 my (@server, $host, $proto, $file, $allok, $i);
1bd42c89
MT
55
56 use File::Basename;
4d504812 57 $bfile = basename("$getfile");
1bd42c89 58
4d504812
MT
59 $i = 0;
60 while (($allok == 0) && $i < 5) {
61 $i++;
62
63 if ("$gethost" eq "") {
64 @server = selectmirror();
65 $proto = $server[0];
66 $host = $server[1];
67 $file = "$server[2]/$getfile";
1bd42c89 68 } else {
4d504812 69 $host = $gethost;
afabe9f7 70 $file = $getfile;
1bd42c89 71 }
4d504812
MT
72
73 $proto = "HTTP" unless $proto;
74
75 logger("Trying to get $file from $host ($proto).");
1bd42c89 76
4d504812
MT
77 my $ua = LWP::UserAgent->new;
78 $ua->agent("Pakfire/$Conf::version");
afabe9f7 79 $ua->timeout(5);
4b122800
MT
80
81 my %proxysettings=();
82 &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings);
83
99e6df8e 84 if ($proxysettings{'UPSTREAM_PROXY'}) {
186e3d2c 85 logger("Using upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"");
4b122800 86 if ($proxysettings{'UPSTREAM_USER'}) {
99e6df8e 87 $ua->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/");
186e3d2c 88 logger(" Logging in with: \"$proxysettings{'UPSTREAM_USER'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"");
4b122800 89 } else {
99e6df8e 90 $ua->proxy("http","http://$proxysettings{'UPSTREAM_PROXY'}/");
4b122800
MT
91 }
92 }
4d504812
MT
93
94 my $response = $ua->get("http://$host/$file");
95
4b122800
MT
96 my $code = $response->code();
97 my $log = $response->status_line;
98 logger("HTTP-Status-Code: $code - $log");
99
100 if ( $code eq "500" ) {
e44b26cf 101 message("Giving up: There was no chance to get the file \"$getfile\" from any available server.\nThere was an error on the way. Please fix it.");
4b122800
MT
102 return 1;
103 }
104
4d504812 105 if ($response->is_success) {
186e3d2c 106 if (open(FILE, ">$Conf::tmpdir/$bfile")) {
4d504812
MT
107 print FILE $response->content;
108 close(FILE);
06209efc
MT
109 unless ($bfile =~ /^counter\?.*/) { # Don't check out counterfile cause it's empty
110 logger("File received. Start checking signature...");
111 if (system("gpg --verify \"$Conf::tmpdir/$bfile\" &>/dev/null") eq 0) {
112 logger("Signature of $bfile is fine.");
113 move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
114 } else {
115 message("The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
116 exit 1;
117 }
186e3d2c 118 }
4b122800 119 logger("Download successfully done from $host (file: $file).");
4d504812
MT
120 $allok = 1;
121 return 0;
122 } else {
123 logger("Could not open $Conf::cachedir/$bfile for writing.");
124 }
125 } else {
4d504812
MT
126 logger("Download $file failed from $host ($proto): $log");
127 }
1bd42c89 128 }
4d504812
MT
129 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.");
130 return 1;
1bd42c89
MT
131}
132
133sub getmirrors {
134 use File::Copy;
135
136 logger("Try to get a mirror list.");
137
06209efc
MT
138 fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver");
139 move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
1bd42c89
MT
140}
141
142sub selectmirror {
143 ### Check if there is a current server list and read it.
144 # If there is no list try to get one.
145 my $count = 0;
06209efc 146 while (!(open(FILE, "<$Conf::dbdir/lists/server-list.db")) && ($count lt 5)) {
1bd42c89
MT
147 $count++;
148 getmirrors();
149 }
150 if ($count == 5) {
151 message("Could not find or download a server list.");
152 exit 1;
153 }
154 my @lines = <FILE>;
155 close(FILE);
156
157 ### Count the number of the servers in the list
158 my $scount = 0;
e44b26cf 159 my @newlines;
1bd42c89 160 foreach (@lines) {
e44b26cf
MT
161 if ("$_" =~ /.*;.*;.*;/ ) {
162 push(@newlines,$_);
163 $scount++;
164 }
1bd42c89
MT
165 }
166 logger("$scount servers found in list.");
167
168 ### Choose a random server and test if it is online
169 # If the check fails try a new server.
170 # This will never give up.
171 my $found = 0;
172 my $servers = 0;
173 while ($found == 0) {
174 $server = int(rand($scount) + 1);
175 $servers = 0;
176 my ($line, $proto, $path, $host);
177 my @templine;
e44b26cf 178 foreach $line (@newlines) {
1bd42c89
MT
179 $servers++;
180 if ($servers eq $server) {
181 @templine = split(/\;/, $line);
182 $proto = $templine[0];
183 $host = $templine[1];
184 $path = $templine[2];
a08c3a2e 185 if (pinghost("$host")) {
1bd42c89
MT
186 $found = 1;
187 return ($proto, $host, $path);
188 }
189 }
190 }
4d504812 191 }
1bd42c89
MT
192}
193
194sub dbgetlist {
195 ### Update the database if the file is older than one day.
196 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
197 # Usage is always with an argument.
198 my $force = shift;
199 my $age;
200
201 use File::Copy;
202
203 if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
204 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
205 my $time = time();
206 $age = $time - $stat[9];
207 } else {
208 # Force an update.
209 $age = "86401";
210 }
211
212 if (("$age" gt 86400) || ("$force" eq "force")) {
5b2a12ff 213 #cleanup();
1bd42c89
MT
214 fetchfile("lists/packages_list.db", "");
215 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
216 }
217}
218
219sub dblist {
220 ### This subroutine lists the packages.
221 # You may also pass a filter: &Pakfire::dblist(filter)
222 # Usage is always with two arguments.
223 # filter may be: all, notinstalled, installed
224 my $filter = shift;
225 my $forweb = shift;
4b122800 226 my @meta;
99e6df8e 227 my @updatepaks;
4b122800
MT
228 my $file;
229 my $line;
230 my $prog;
231 my ($name, $version, $release);
232 my @templine;
1bd42c89
MT
233
234 ### Make sure that the list is not outdated.
235 dbgetlist("noforce");
236
237 open(FILE, "<$Conf::dbdir/lists/packages_list.db");
238 my @db = <FILE>;
239 close(FILE);
4b122800
MT
240
241 if ("$filter" eq "upgrade") {
242 opendir(DIR,"$Conf::dbdir/meta");
243 my @files = readdir(DIR);
244 closedir(DIR);
245 foreach $file (@files) {
246 next if ( $file eq "." );
247 next if ( $file eq ".." );
248 open(FILE, "<$Conf::dbdir/meta/$file");
249 @meta = <FILE>;
250 close(FILE);
251 foreach $line (@meta) {
252 @templine = split(/\: /,$line);
253 if ("$templine[0]" eq "Name") {
254 $name = $templine[1];
255 chomp($name);
256 } elsif ("$templine[0]" eq "ProgVersion") {
257 $version = $templine[1];
258 chomp($version);
259 } elsif ("$templine[0]" eq "Release") {
260 $release = $templine[1];
261 chomp($release);
262 }
263 }
264 foreach $prog (@db) {
265 @templine = split(/\;/,$prog);
266 if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" )) {
99e6df8e 267 push(@updatepaks,$name);
4b122800
MT
268 if ("$forweb" eq "forweb") {
269 print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
270 } else {
271 print "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n\n";
272 }
273 }
274 }
5b2a12ff 275 }
99e6df8e 276 return @updatepaks;
4b122800
MT
277 } else {
278 my $line;
279 my @templine;
280 foreach $line (sort @db) {
06209efc 281 next unless ($line =~ /.*;.*;.*;/ );
4b122800
MT
282 @templine = split(/\;/,$line);
283 if ("$filter" eq "notinstalled") {
284 next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
285 } elsif ("$filter" eq "installed") {
286 next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
287 }
288 if ("$forweb" eq "forweb") {
289 print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
290 } else {
291 print "Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]\n\n";
292 }
1bd42c89
MT
293 }
294 }
295}
296
297sub resolvedeps {
298 my $pak = shift;
299
300 getmetafile("$pak");
301
186e3d2c
MT
302 message("");
303 message("## Resolving dependencies for $pak...");
1bd42c89
MT
304
305 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
306 my @file = <FILE>;
307 close(FILE);
308
309 my $line;
186e3d2c 310 my (@templine, @deps, @tempdeps, @all);
1bd42c89
MT
311 foreach $line (@file) {
312 @templine = split(/\: /,$line);
313 if ("$templine[0]" eq "Dependencies") {
314 @deps = split(/ /, $templine[1]);
315 }
316 }
317 chomp (@deps);
318 foreach (@deps) {
319 if ($_) {
186e3d2c
MT
320 my $return = &isinstalled($_);
321 if ($return eq 0) {
322 message("### Dependency is already installed: $_");
323 } else {
324 message("### Need to install dependency: $_");
325 push(@tempdeps,$_);
326 push(@all,$_);
327 }
1bd42c89
MT
328 }
329 }
e44b26cf 330
1bd42c89
MT
331 foreach (@tempdeps) {
332 if ($_) {
333 my @newdeps = resolvedeps("$_");
334 foreach(@newdeps) {
335 unless (($_ eq " ") || ($_ eq "")) {
186e3d2c
MT
336 my $return = &isinstalled($_);
337 if ($return eq 0) {
338 message("### Dependency is already installed: $_");
339 } else {
340 message("### Need to install dependency: $_");
341 push(@all,$_);
342 }
1bd42c89
MT
343 }
344 }
345 }
346 }
186e3d2c
MT
347 chomp (@all);
348 return @all;
1bd42c89
MT
349}
350
351sub cleanup {
352 my $dir = shift;
353 my $path;
354
355 if ( "$dir" eq "meta" ) {
356 $path = "$Conf::dbdir/meta";
357 } elsif ( "$dir" eq "tmp" ) {
358 $path = "$Conf::tmpdir";
359 }
360 chdir("$path");
361 opendir(DIR,".");
362 my @files = readdir(DIR);
363 closedir(DIR);
364 foreach (@files) {
365 unless (($_ eq ".") || ($_ eq "..")) {
366 system("rm -rf $_");
367 }
368 }
369}
370
371sub getmetafile {
372 my $pak = shift;
373
374 logger("Going to download meta-$pak.");
375
376 unless ( -e "$Conf::dbdir/meta/meta-$pak") {
377 fetchfile("meta/meta-$pak", "");
378 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
379 }
380
381 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
382 my @line = <FILE>;
383 close(FILE);
384
385 open(FILE, ">$Conf::dbdir/meta/meta-$pak");
386 foreach (@line) {
387 my $string = $_;
388 $string =~ s/\r\n/\n/g;
389 print FILE $string;
390 }
391 close(FILE);
392 return 1;
393}
394
395sub getsize {
396 my $pak = shift;
397
398 getmetafile("$pak");
399
400 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
401 my @file = <FILE>;
402 close(FILE);
403
404 my $line;
405 my @templine;
406 foreach $line (@file) {
407 @templine = split(/\: /,$line);
408 if ("$templine[0]" eq "Size") {
409 chomp($templine[1]);
410 return $templine[1];
411 }
412 }
4b122800 413 return 0;
1bd42c89
MT
414}
415
416sub decryptpak {
417 my $pak = shift;
418
419 cleanup("tmp");
420
421 my $file = getpak("$pak", "noforce");
422
99e6df8e
MT
423 my $return = system("cd $Conf::tmpdir/ && gpg -d < $Conf::cachedir/$file | tar x >/dev/null 2>&1");
424 $return %= 255;
1bd42c89 425 logger("Decryption process returned the following: $return");
cde0e116 426 if ($return != 0) { exit 1; }
1bd42c89
MT
427}
428
429sub getpak {
430 my $pak = shift;
431 my $force = shift;
432
433 getmetafile("$pak");
434
435 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
436 my @file = <FILE>;
437 close(FILE);
438
439 my $line;
440 my $file;
441 my @templine;
442 foreach $line (@file) {
443 @templine = split(/\: /,$line);
444 if ("$templine[0]" eq "File") {
445 chomp($templine[1]);
446 $file = $templine[1];
447 }
448 }
449
450 unless ($file) {
451 message("No filename given in meta-file. Please phone the developers.");
452 exit 1;
453 }
454
1bd42c89
MT
455 unless ( "$force" eq "force" ) {
456 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
457 return $file;
458 }
459 }
460
461 fetchfile("paks/$file", "");
462 return $file;
463}
464
465sub setuppak {
466 my $pak = shift;
467
186e3d2c
MT
468 message("################################################################################");
469 message("# --> Installing: $pak");
470 message("################################################################################");
1bd42c89
MT
471
472 decryptpak("$pak");
473
99e6df8e 474 my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
cde0e116 475 $return %= 255;
e44b26cf
MT
476 if ($pakfiresettings{'UUID'} ne "off") {
477 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&ipak=$pak&return=$return", "$Conf::mainserver");
478 }
1bd42c89
MT
479 if ($return == 0) {
480 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
481 cleanup("tmp");
4d504812 482 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
1bd42c89 483 message("Setup completed. Congratulations!");
186e3d2c 484 message("################################################################################");
1bd42c89
MT
485 } else {
486 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
487 exit $return;
488 }
a08c3a2e 489 return $return;
1bd42c89
MT
490}
491
186e3d2c
MT
492sub isinstalled {
493 my $pak = shift;
494 if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) {
495 close(FILE);
496 return 0;
497 } else {
498 return 1;
499 }
500}
501
99e6df8e 502sub upgradepak {
1bd42c89
MT
503 my $pak = shift;
504
99e6df8e 505 message("We are going to upgrade: $pak");
1bd42c89
MT
506
507 decryptpak("$pak");
508
99e6df8e
MT
509 my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
510 $return %= 255;
e44b26cf
MT
511 if ($pakfiresettings{'UUID'} ne "off") {
512 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&upak=$pak&return=$return", "$Conf::mainserver");
513 }
1bd42c89
MT
514 if ($return == 0) {
515 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
516 cleanup("tmp");
99e6df8e
MT
517 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
518 message("Upgrade completed. Congratulations!");
1bd42c89
MT
519 } else {
520 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
521 exit $return;
522 }
8e58bd37 523 return $return;
1bd42c89
MT
524}
525
526sub removepak {
527 my $pak = shift;
528
529 message("We are going to uninstall: $pak");
530
531 decryptpak("$pak");
532
99e6df8e
MT
533 my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
534 $return %= 255;
e44b26cf
MT
535 if ($pakfiresettings{'UUID'} ne "off") {
536 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&dpak=$pak&return=$return", "$Conf::mainserver");
537 }
1bd42c89
MT
538 if ($return == 0) {
539 open(FILE, "<$Conf::dbdir/rootfiles/$pak");
540 my @file = <FILE>;
541 close(FILE);
542 foreach (@file) {
543 my $line = $_;
544 chomp($line);
545 system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
546 system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
547 }
548 unlink("$Conf::dbdir/rootfiles/$pak");
549 cleanup("tmp");
550 message("Uninstall completed. Congratulations!");
551 } else {
552 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
553 exit $return;
554 }
8e58bd37 555 return $return;
1bd42c89
MT
556}
557
558sub beautifysize {
559 my $size = shift;
a08c3a2e
MT
560 $size = $size / 1024;
561 my $unit;
1bd42c89
MT
562
563 if ($size > 1023) {
a08c3a2e
MT
564 $size = ($size / 1024);
565 $unit = "MB";
1bd42c89 566 } else {
a08c3a2e 567 $unit = "KB";
1bd42c89 568 }
a08c3a2e
MT
569 $size = sprintf("%.2f" , $size);
570 my $string = "$size $unit";
571 return $string;
1bd42c89
MT
572}
573
8e58bd37
MT
574sub makeuuid {
575 unless ( -e "$Conf::dbdir/uuid" ) {
8e58bd37
MT
576 open(FILE, "</proc/sys/kernel/random/uuid");
577 my @line = <FILE>;
578 close(FILE);
579
580 open(FILE, ">$Conf::dbdir/uuid");
581 foreach (@line) {
582 print FILE $_;
583 }
584 close(FILE);
585 }
586}
587
588sub senduuid {
99e6df8e 589 if ($pakfiresettings{'UUID'} ne "off") {
4b122800
MT
590 unless("$Conf::uuid") {
591 $Conf::uuid = `cat $Conf::dbdir/uuid`;
592 }
593 logger("Sending my uuid: $Conf::uuid");
594 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
06209efc 595 system("rm -f $Conf::tmpdir/counter* 2>/dev/null");
8e58bd37 596 }
8e58bd37 597}
1bd42c89 598
cde0e116
MT
599sub checkcryptodb {
600 my $myid = "64D96617"; # Our own gpg-key
601 my $trustid = "65D0FD58"; # Id of CaCert
602 my $ret = system("gpg --list-keys | grep -q $myid");
603 unless ( "$ret" eq "0" ) {
604 message("The GnuPG isn't configured corectly. Trying now to fix this.");
605 system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $myid");
606 system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid");
607 }
608}
609
1bd42c89 6101;