Pakfire laedt die Listen jetzt besser und hat eine veraenderte Oberflaeche bekommen.
[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;
a6d327a7
MT
10use HTTP::Headers;
11use HTTP::Message;
12use HTTP::Request;
1bd42c89
MT
13use Net::Ping;
14
15package Pakfire;
16
750c1528
MT
17# GPG Keys
18my $myid = "64D96617"; # Our own gpg-key paks@ipfire.org
19my $trustid = "65D0FD58"; # gpg-key of CaCert
20
35f38a8b
MT
21# A small color-hash :D
22my %color;
23 $color{'normal'} = "\033[0m";
24 $color{'black'} = "\033[0;30m";
25 $color{'darkgrey'} = "\033[1;30m";
26 $color{'blue'} = "\033[0;34m";
27 $color{'lightblue'} = "\033[1;34m";
28 $color{'green'} = "\033[0;32m";
29 $color{'lightgreen'} = "\033[1;32m";
30 $color{'cyan'} = "\033[0;36m";
31 $color{'lightcyan'} = "\033[1;36m";
32 $color{'red'} = "\033[0;31m";
33 $color{'lightred'} = "\033[1;31m";
34 $color{'purple'} = "\033[0;35m";
35 $color{'lightpurple'} = "\033[1;35m";
36 $color{'brown'} = "\033[0;33m";
37 $color{'lightgrey'} = "\033[0;37m";
38 $color{'yellow'} = "\033[1;33m";
39 $color{'white'} = "\033[1;37m";
750c1528 40our $enable_colors = 1;
35f38a8b 41
a6d327a7
MT
42my $final_data;
43my $total_size;
44my $bfile;
45
4b122800
MT
46my %pakfiresettings = ();
47&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
48
1bd42c89
MT
49sub message {
50 my $message = shift;
35f38a8b 51
1bd42c89 52 logger("$message");
750c1528
MT
53 if ( $enable_colors == 1 ) {
54 if ("$message" =~ /ERROR/) {
55 $message = "$color{'red'}$message$color{'normal'}";
56 } elsif ("$message" =~ /INFO/) {
57 $message = "$color{'cyan'}$message$color{'normal'}";
58 } elsif ("$message" =~ /WARN/) {
59 $message = "$color{'yellow'}$message$color{'normal'}";
60 } elsif ("$message" =~ /RESV/) {
61 $message = "$color{'purple'}$message$color{'normal'}";
62 } elsif ("$message" =~ /INST/) {
63 $message = "$color{'green'}$message$color{'normal'}";
64 } elsif ("$message" =~ /REMV/) {
65 $message = "$color{'lightred'}$message$color{'normal'}";
66 } elsif ("$message" =~ /UPGR/) {
67 $message = "$color{'lightblue'}$message$color{'normal'}";
68 }
35f38a8b
MT
69 }
70 print "$message\n";
71
1bd42c89
MT
72}
73
74sub logger {
75 my $log = shift;
9ced24a8
MT
76 if ($log) {
77 system("echo \"`date`: $log\" >> /var/log/pakfire.log");
78 #system("logger -t pakfire \"$log\"");
79 }
1bd42c89
MT
80}
81
5b2a12ff 82sub usage {
750c1528 83 &Pakfire::message("Usage: pakfire <install|remove> [options] <pak(s)>");
5b2a12ff 84 &Pakfire::message(" <update> - Contacts the servers for new lists of paks.");
99e6df8e 85 &Pakfire::message(" <upgrade> - Installs the latest version of all paks.");
5b2a12ff 86 &Pakfire::message(" <list> - Outputs a short list with all available paks.");
99e6df8e 87 &Pakfire::message("");
750c1528
MT
88 &Pakfire::message(" Global options:");
89 &Pakfire::message(" --non-interactive --> Enables the non-interactive mode.");
90 &Pakfire::message(" You won't see any question here.");
91 &Pakfire::message(" -y --> Short for --non-interactive.");
92 &Pakfire::message(" --no-colors --> Turns off the wonderful colors.");
93 &Pakfire::message("");
5b2a12ff
MT
94 exit 1;
95}
96
1bd42c89
MT
97sub pinghost {
98 my $host = shift;
99
100 $p = Net::Ping->new();
101 if ($p->ping($host)) {
a6d327a7 102 logger("PING INFO: $host is alive");
1bd42c89
MT
103 return 1;
104 } else {
a6d327a7 105 logger("PING INFO: $host is unreachable");
1bd42c89
MT
106 return 0;
107 }
108 $p->close();
109}
110
111sub fetchfile {
4d504812
MT
112 my $getfile = shift;
113 my $gethost = shift;
377560fb
MT
114 my (@server, $host, $proto, $file, $i);
115 my $allok = 0;
1bd42c89
MT
116
117 use File::Basename;
4d504812 118 $bfile = basename("$getfile");
377560fb
MT
119
120 logger("DOWNLOAD STARTED: $getfile") unless ($bfile =~ /^counter\?.*/);
1bd42c89 121
4d504812
MT
122 $i = 0;
123 while (($allok == 0) && $i < 5) {
124 $i++;
125
126 if ("$gethost" eq "") {
127 @server = selectmirror();
128 $proto = $server[0];
129 $host = $server[1];
130 $file = "$server[2]/$getfile";
1bd42c89 131 } else {
4d504812 132 $host = $gethost;
afabe9f7 133 $file = $getfile;
1bd42c89 134 }
4d504812
MT
135
136 $proto = "HTTP" unless $proto;
137
a6d327a7
MT
138 unless ($bfile =~ /^counter\?.*/) {
139 logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file");
a6d327a7 140 }
1bd42c89 141
4d504812
MT
142 my $ua = LWP::UserAgent->new;
143 $ua->agent("Pakfire/$Conf::version");
afabe9f7 144 $ua->timeout(5);
4b122800
MT
145
146 my %proxysettings=();
147 &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings);
148
99e6df8e 149 if ($proxysettings{'UPSTREAM_PROXY'}) {
a6d327a7 150 logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"") unless ($bfile =~ /^counter\?.*/);
4b122800 151 if ($proxysettings{'UPSTREAM_USER'}) {
99e6df8e 152 $ua->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/");
a6d327a7 153 logger("DOWNLOAD INFO: Logging in with: \"$proxysettings{'UPSTREAM_USER'}\" - \"$proxysettings{'UPSTREAM_PASSWORD'}\"") unless ($bfile =~ /^counter\?.*/);
4b122800 154 } else {
99e6df8e 155 $ua->proxy("http","http://$proxysettings{'UPSTREAM_PROXY'}/");
4b122800
MT
156 }
157 }
a6d327a7
MT
158
159 $final_data = undef;
160 my $url = "http://$host/$file";
161 my $response;
162
163 unless ($bfile =~ /^counter\?.*/) {
164 my $result = $ua->head($url);
165 my $remote_headers = $result->headers;
166 $total_size = $remote_headers->content_length;
167 logger("DOWNLOAD INFO: $file has size of $total_size bytes");
168
169 $response = $ua->get($url, ':content_cb' => \&callback );
170 message("");
171 } else {
172 $response = $ua->get($url);
173 }
4d504812 174
4b122800
MT
175 my $code = $response->code();
176 my $log = $response->status_line;
a6d327a7 177 logger("DOWNLOAD INFO: HTTP-Status-Code: $code - $log");
4b122800
MT
178
179 if ( $code eq "500" ) {
e44b26cf 180 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
181 return 1;
182 }
183
4d504812 184 if ($response->is_success) {
35f38a8b
MT
185 unless ($bfile =~ /^counter\?.*/) {
186 if (open(FILE, ">$Conf::tmpdir/$bfile")) {
187 print FILE $final_data;
188 close(FILE);
a6d327a7 189 logger("DOWNLOAD INFO: File received. Start checking signature...");
06209efc 190 if (system("gpg --verify \"$Conf::tmpdir/$bfile\" &>/dev/null") eq 0) {
a6d327a7 191 logger("DOWNLOAD INFO: Signature of $bfile is fine.");
06209efc
MT
192 move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
193 } else {
a6d327a7 194 message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
06209efc
MT
195 exit 1;
196 }
35f38a8b
MT
197 logger("DOWNLOAD FINISHED: $file");
198 $allok = 1;
199 return 0;
200 } else {
201 logger("DOWNLOAD ERROR: Could not open $Conf::cachedir/$bfile for writing.");
186e3d2c 202 }
4d504812 203 } else {
35f38a8b 204 return 0;
4d504812
MT
205 }
206 } else {
a6d327a7 207 logger("DOWNLOAD ERROR: $log");
4d504812 208 }
1bd42c89 209 }
a6d327a7 210 message("DOWNLOAD ERROR: 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.");
4d504812 211 return 1;
1bd42c89
MT
212}
213
214sub getmirrors {
377560fb
MT
215 my $force = shift;
216 my $age;
217
1bd42c89 218 use File::Copy;
1bd42c89 219
2aa6d448
MT
220 if ( -e "$Conf::dbdir/lists/server-list.db" ) {
221 my @stat = stat("$Conf::dbdir/lists/server-list.db");
e3670217
MT
222 my $time = time();
223 $age = $time - $stat[9];
377560fb
MT
224 $force = "force" if ("$age" >= "3600");
225 logger("MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force");
e3670217
MT
226 } else {
227 # Force an update.
377560fb 228 $force = "force";
e3670217
MT
229 }
230
377560fb 231 if ("$force" eq "force") {
e3670217
MT
232 fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver");
233 move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
234 }
1bd42c89
MT
235}
236
2aa6d448 237sub getcoredb {
377560fb
MT
238 my $force = shift;
239 my $age;
240
2aa6d448 241 use File::Copy;
2aa6d448
MT
242
243 if ( -e "$Conf::dbdir/lists/core-list.db" ) {
244 my @stat = stat("$Conf::dbdir/lists/core-list.db");
245 my $time = time();
246 $age = $time - $stat[9];
377560fb
MT
247 $force = "force" if ("$age" >= "3600");
248 logger("CORE INFO: core-list.db is $age seconds old. - DEBUG: $force");
2aa6d448
MT
249 } else {
250 # Force an update.
377560fb 251 $force = "force";
2aa6d448
MT
252 }
253
377560fb 254 if ("$force" eq "force") {
2aa6d448
MT
255 fetchfile("lists/core-list.db", "");
256 move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db");
257 }
258}
259
260
1bd42c89
MT
261sub selectmirror {
262 ### Check if there is a current server list and read it.
263 # If there is no list try to get one.
264 my $count = 0;
06209efc 265 while (!(open(FILE, "<$Conf::dbdir/lists/server-list.db")) && ($count lt 5)) {
1bd42c89 266 $count++;
377560fb 267 getmirrors("noforce");
1bd42c89
MT
268 }
269 if ($count == 5) {
a6d327a7 270 message("MIRROR ERROR: Could not find or download a server list");
1bd42c89
MT
271 exit 1;
272 }
273 my @lines = <FILE>;
274 close(FILE);
275
276 ### Count the number of the servers in the list
277 my $scount = 0;
e44b26cf 278 my @newlines;
1bd42c89 279 foreach (@lines) {
e44b26cf
MT
280 if ("$_" =~ /.*;.*;.*;/ ) {
281 push(@newlines,$_);
282 $scount++;
283 }
1bd42c89 284 }
a6d327a7 285 logger("MIRROR INFO: $scount servers found in list");
1bd42c89
MT
286
287 ### Choose a random server and test if it is online
288 # If the check fails try a new server.
289 # This will never give up.
290 my $found = 0;
291 my $servers = 0;
292 while ($found == 0) {
293 $server = int(rand($scount) + 1);
294 $servers = 0;
295 my ($line, $proto, $path, $host);
296 my @templine;
e44b26cf 297 foreach $line (@newlines) {
1bd42c89
MT
298 $servers++;
299 if ($servers eq $server) {
300 @templine = split(/\;/, $line);
301 $proto = $templine[0];
302 $host = $templine[1];
303 $path = $templine[2];
a08c3a2e 304 if (pinghost("$host")) {
1bd42c89
MT
305 $found = 1;
306 return ($proto, $host, $path);
307 }
308 }
309 }
4d504812 310 }
1bd42c89
MT
311}
312
313sub dbgetlist {
314 ### Update the database if the file is older than one day.
315 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
316 # Usage is always with an argument.
317 my $force = shift;
318 my $age;
319
320 use File::Copy;
321
322 if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
323 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
324 my $time = time();
325 $age = $time - $stat[9];
377560fb
MT
326 $force = "force" if ("$age" >= "3600");
327 logger("DB INFO: packages_list.db is $age seconds old. - DEBUG: $force");
1bd42c89
MT
328 } else {
329 # Force an update.
377560fb 330 $force = "force";
1bd42c89
MT
331 }
332
377560fb 333 if ("$force" eq "force") {
1bd42c89
MT
334 fetchfile("lists/packages_list.db", "");
335 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
336 }
337}
338
339sub dblist {
340 ### This subroutine lists the packages.
341 # You may also pass a filter: &Pakfire::dblist(filter)
342 # Usage is always with two arguments.
343 # filter may be: all, notinstalled, installed
344 my $filter = shift;
345 my $forweb = shift;
4b122800 346 my @meta;
99e6df8e 347 my @updatepaks;
4b122800
MT
348 my $file;
349 my $line;
350 my $prog;
351 my ($name, $version, $release);
352 my @templine;
1bd42c89
MT
353
354 ### Make sure that the list is not outdated.
377560fb 355 #dbgetlist("noforce");
1bd42c89
MT
356
357 open(FILE, "<$Conf::dbdir/lists/packages_list.db");
358 my @db = <FILE>;
359 close(FILE);
4b122800
MT
360
361 if ("$filter" eq "upgrade") {
377560fb 362 getcoredb("noforce");
8a8a50ad
MT
363 eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
364 if ("$core_release" gt "$Conf::core_mine") {
365 if ("$forweb" eq "forweb") {
366 print "<option value=\"core\">Core-Update -- $Conf::version -- Release: $Conf::core_mine -> $core_release</option>\n";
367 } else {
368 my $command = "Core-Update $Conf::version\nRelease: $Conf::core_mine -> $core_release\n";
369 if ("$Pakfire::enable_colors" eq "1") {
370 print "$color{'lila'}$command$color{'normal'}\n";
371 } else {
372 print "$command\n";
373 }
374 }
375 }
376
4b122800
MT
377 opendir(DIR,"$Conf::dbdir/meta");
378 my @files = readdir(DIR);
379 closedir(DIR);
380 foreach $file (@files) {
381 next if ( $file eq "." );
382 next if ( $file eq ".." );
383 open(FILE, "<$Conf::dbdir/meta/$file");
384 @meta = <FILE>;
385 close(FILE);
386 foreach $line (@meta) {
387 @templine = split(/\: /,$line);
388 if ("$templine[0]" eq "Name") {
389 $name = $templine[1];
390 chomp($name);
391 } elsif ("$templine[0]" eq "ProgVersion") {
392 $version = $templine[1];
393 chomp($version);
394 } elsif ("$templine[0]" eq "Release") {
395 $release = $templine[1];
396 chomp($release);
397 }
398 }
399 foreach $prog (@db) {
400 @templine = split(/\;/,$prog);
401 if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" )) {
99e6df8e 402 push(@updatepaks,$name);
4b122800
MT
403 if ("$forweb" eq "forweb") {
404 print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
405 } else {
e3670217
MT
406 my $command = "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n";
407 if ("$Pakfire::enable_colors" eq "1") {
408 print "$color{'lila'}$command$color{'normal'}\n";
409 } else {
410 print "$command\n";
411 }
4b122800
MT
412 }
413 }
414 }
5b2a12ff 415 }
99e6df8e 416 return @updatepaks;
4b122800
MT
417 } else {
418 my $line;
e3670217 419 my $use_color;
4b122800 420 my @templine;
e3670217 421 my $count;
4b122800 422 foreach $line (sort @db) {
06209efc 423 next unless ($line =~ /.*;.*;.*;/ );
e3670217
MT
424 $use_color = "";
425 $count++;
4b122800
MT
426 @templine = split(/\;/,$line);
427 if ("$filter" eq "notinstalled") {
428 next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
429 } elsif ("$filter" eq "installed") {
430 next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
431 }
432 if ("$forweb" eq "forweb") {
433 print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
434 } else {
e3670217
MT
435 if ("$Pakfire::enable_colors" eq "1") {
436 if (&isinstalled("$templine[0]")) {
437 $use_color = "$color{'red'}"
438 } else {
439 $use_color = "$color{'green'}"
440 }
441 }
442 print "${use_color}Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]$color{'normal'}\n\n";
4b122800 443 }
1bd42c89 444 }
e3670217 445 print "$count packages total.\n" unless ("$forweb" eq "forweb");
1bd42c89
MT
446 }
447}
448
449sub resolvedeps {
450 my $pak = shift;
451
452 getmetafile("$pak");
453
35f38a8b 454 message("PAKFIRE RESV: $pak: Resolving dependencies...");
1bd42c89
MT
455
456 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
457 my @file = <FILE>;
458 close(FILE);
459
460 my $line;
186e3d2c 461 my (@templine, @deps, @tempdeps, @all);
1bd42c89
MT
462 foreach $line (@file) {
463 @templine = split(/\: /,$line);
464 if ("$templine[0]" eq "Dependencies") {
465 @deps = split(/ /, $templine[1]);
466 }
467 }
468 chomp (@deps);
469 foreach (@deps) {
470 if ($_) {
186e3d2c
MT
471 my $return = &isinstalled($_);
472 if ($return eq 0) {
35f38a8b 473 message("PAKFIRE RESV: $pak: Dependency is already installed: $_");
186e3d2c 474 } else {
35f38a8b 475 message("PAKFIRE RESV: $pak: Need to install dependency: $_");
186e3d2c
MT
476 push(@tempdeps,$_);
477 push(@all,$_);
478 }
1bd42c89
MT
479 }
480 }
e44b26cf 481
1bd42c89
MT
482 foreach (@tempdeps) {
483 if ($_) {
484 my @newdeps = resolvedeps("$_");
485 foreach(@newdeps) {
486 unless (($_ eq " ") || ($_ eq "")) {
186e3d2c
MT
487 my $return = &isinstalled($_);
488 if ($return eq 0) {
35f38a8b 489 message("PAKFIRE RESV: $pak: Dependency is already installed: $_");
186e3d2c 490 } else {
35f38a8b 491 message("PAKFIRE RESV: $pak: Need to install dependency: $_");
186e3d2c
MT
492 push(@all,$_);
493 }
1bd42c89
MT
494 }
495 }
496 }
497 }
35f38a8b 498 message("");
186e3d2c
MT
499 chomp (@all);
500 return @all;
1bd42c89
MT
501}
502
503sub cleanup {
504 my $dir = shift;
505 my $path;
506
35f38a8b
MT
507 logger("CLEANUP: $dir");
508
1bd42c89
MT
509 if ( "$dir" eq "meta" ) {
510 $path = "$Conf::dbdir/meta";
511 } elsif ( "$dir" eq "tmp" ) {
512 $path = "$Conf::tmpdir";
513 }
514 chdir("$path");
515 opendir(DIR,".");
516 my @files = readdir(DIR);
517 closedir(DIR);
518 foreach (@files) {
519 unless (($_ eq ".") || ($_ eq "..")) {
520 system("rm -rf $_");
521 }
522 }
523}
524
525sub getmetafile {
526 my $pak = shift;
527
1bd42c89
MT
528 unless ( -e "$Conf::dbdir/meta/meta-$pak") {
529 fetchfile("meta/meta-$pak", "");
530 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
531 }
532
533 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
534 my @line = <FILE>;
535 close(FILE);
536
537 open(FILE, ">$Conf::dbdir/meta/meta-$pak");
538 foreach (@line) {
539 my $string = $_;
540 $string =~ s/\r\n/\n/g;
541 print FILE $string;
542 }
543 close(FILE);
544 return 1;
545}
546
547sub getsize {
548 my $pak = shift;
549
550 getmetafile("$pak");
551
552 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
553 my @file = <FILE>;
554 close(FILE);
555
556 my $line;
557 my @templine;
558 foreach $line (@file) {
559 @templine = split(/\: /,$line);
560 if ("$templine[0]" eq "Size") {
561 chomp($templine[1]);
562 return $templine[1];
563 }
564 }
4b122800 565 return 0;
1bd42c89
MT
566}
567
568sub decryptpak {
569 my $pak = shift;
570
571 cleanup("tmp");
572
573 my $file = getpak("$pak", "noforce");
574
a6d327a7 575 logger("DECRYPT STARTED: $pak");
35f38a8b 576 my $return = system("cd $Conf::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf::cachedir/$file 2>/dev/null | tar x");
99e6df8e 577 $return %= 255;
a6d327a7 578 logger("DECRYPT FINISHED: $pak - Status: $return");
cde0e116 579 if ($return != 0) { exit 1; }
1bd42c89
MT
580}
581
582sub getpak {
583 my $pak = shift;
584 my $force = shift;
585
586 getmetafile("$pak");
587
588 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
589 my @file = <FILE>;
590 close(FILE);
591
592 my $line;
593 my $file;
594 my @templine;
595 foreach $line (@file) {
596 @templine = split(/\: /,$line);
597 if ("$templine[0]" eq "File") {
598 chomp($templine[1]);
599 $file = $templine[1];
600 }
601 }
602
603 unless ($file) {
604 message("No filename given in meta-file. Please phone the developers.");
605 exit 1;
606 }
607
1bd42c89
MT
608 unless ( "$force" eq "force" ) {
609 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
610 return $file;
611 }
612 }
613
614 fetchfile("paks/$file", "");
615 return $file;
616}
617
618sub setuppak {
619 my $pak = shift;
620
35f38a8b 621 message("PAKFIRE INST: $pak: Decrypting...");
1bd42c89
MT
622 decryptpak("$pak");
623
35f38a8b 624 message("PAKFIRE INST: $pak: Copying files and running post-installation scripts...");
99e6df8e 625 my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
cde0e116 626 $return %= 255;
e44b26cf
MT
627 if ($pakfiresettings{'UUID'} ne "off") {
628 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&ipak=$pak&return=$return", "$Conf::mainserver");
629 }
1bd42c89
MT
630 if ($return == 0) {
631 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
632 cleanup("tmp");
4d504812 633 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
35f38a8b
MT
634 message("PAKFIRE INST: $pak: Finished.");
635 message("");
1bd42c89 636 } else {
35f38a8b 637 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
1bd42c89
MT
638 exit $return;
639 }
a08c3a2e 640 return $return;
1bd42c89
MT
641}
642
2aa6d448 643sub upgradecore {
377560fb 644 getcoredb("noforce");
2aa6d448
MT
645 eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
646 if ("$core_release" gt "$Conf::core_mine") {
647 message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release");
648
649 my @seq = `seq $Conf::core_mine $core_release`;
650 shift @seq;
651 my $release;
652 foreach $release (@seq) {
653 chomp($release);
654 getpak("core-upgrade-$release");
655 }
656
657 foreach $release (@seq) {
658 chomp($release);
659 upgradepak("core-upgrade-$release");
660 }
661
662 system("echo $core_release > $Conf::coredir/mine");
663
664 } else {
665 message("CORE ERROR: No new upgrades available. You are on release $Conf::core_mine.");
666 }
667}
668
186e3d2c
MT
669sub isinstalled {
670 my $pak = shift;
671 if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) {
672 close(FILE);
673 return 0;
674 } else {
675 return 1;
676 }
677}
678
99e6df8e 679sub upgradepak {
1bd42c89
MT
680 my $pak = shift;
681
35f38a8b 682 message("PAKFIRE UPGR: $pak: Decrypting...");
1bd42c89
MT
683 decryptpak("$pak");
684
35f38a8b 685 message("PAKFIRE UPGR: $pak: Upgrading files and running post-upgrading scripts...");
99e6df8e
MT
686 my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
687 $return %= 255;
e44b26cf
MT
688 if ($pakfiresettings{'UUID'} ne "off") {
689 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&upak=$pak&return=$return", "$Conf::mainserver");
690 }
1bd42c89
MT
691 if ($return == 0) {
692 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
693 cleanup("tmp");
99e6df8e 694 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
35f38a8b
MT
695 message("PAKFIRE UPGR: $pak: Finished.");
696 message("");
1bd42c89 697 } else {
35f38a8b 698 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
1bd42c89
MT
699 exit $return;
700 }
8e58bd37 701 return $return;
1bd42c89
MT
702}
703
704sub removepak {
705 my $pak = shift;
706
35f38a8b 707 message("PAKFIRE REMV: $pak: Decrypting...");
1bd42c89
MT
708 decryptpak("$pak");
709
35f38a8b 710 message("PAKFIRE REMV: $pak: Removing files and running post-removing scripts...");
99e6df8e
MT
711 my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
712 $return %= 255;
e44b26cf
MT
713 if ($pakfiresettings{'UUID'} ne "off") {
714 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid&dpak=$pak&return=$return", "$Conf::mainserver");
715 }
1bd42c89
MT
716 if ($return == 0) {
717 open(FILE, "<$Conf::dbdir/rootfiles/$pak");
718 my @file = <FILE>;
719 close(FILE);
720 foreach (@file) {
721 my $line = $_;
722 chomp($line);
723 system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
724 system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
725 }
726 unlink("$Conf::dbdir/rootfiles/$pak");
a6d327a7 727 unlink("$Conf::dbdir/installed/meta-$pak");
1bd42c89 728 cleanup("tmp");
35f38a8b
MT
729 message("PAKFIRE REMV: $pak: Finished.");
730 message("");
1bd42c89 731 } else {
35f38a8b 732 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
1bd42c89
MT
733 exit $return;
734 }
8e58bd37 735 return $return;
1bd42c89
MT
736}
737
738sub beautifysize {
739 my $size = shift;
35f38a8b 740 #$size = $size / 1024;
a08c3a2e 741 my $unit;
1bd42c89 742
35f38a8b
MT
743 if ($size > 1023*1024) {
744 $size = ($size / (1024*1024));
a08c3a2e 745 $unit = "MB";
35f38a8b
MT
746 } elsif ($size > 1023) {
747 $size = ($size / 1024);
a08c3a2e 748 $unit = "KB";
35f38a8b
MT
749 } else {
750 $unit = "B";
1bd42c89 751 }
a08c3a2e
MT
752 $size = sprintf("%.2f" , $size);
753 my $string = "$size $unit";
754 return $string;
1bd42c89
MT
755}
756
8e58bd37
MT
757sub makeuuid {
758 unless ( -e "$Conf::dbdir/uuid" ) {
8e58bd37
MT
759 open(FILE, "</proc/sys/kernel/random/uuid");
760 my @line = <FILE>;
761 close(FILE);
762
763 open(FILE, ">$Conf::dbdir/uuid");
764 foreach (@line) {
765 print FILE $_;
766 }
767 close(FILE);
768 }
769}
770
771sub senduuid {
99e6df8e 772 if ($pakfiresettings{'UUID'} ne "off") {
4b122800
MT
773 unless("$Conf::uuid") {
774 $Conf::uuid = `cat $Conf::dbdir/uuid`;
775 }
776 logger("Sending my uuid: $Conf::uuid");
777 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
06209efc 778 system("rm -f $Conf::tmpdir/counter* 2>/dev/null");
8e58bd37 779 }
8e58bd37 780}
1bd42c89 781
cde0e116 782sub checkcryptodb {
a6d327a7 783 logger("CRYPTO INFO: Checking GnuPG Database");
cde0e116
MT
784 my $ret = system("gpg --list-keys | grep -q $myid");
785 unless ( "$ret" eq "0" ) {
a6d327a7
MT
786 message("CRYPTO WARN: The GnuPG isn't configured corectly. Trying now to fix this.");
787 message("CRYPTO WARN: It's normal to see this on first execution.");
a4c9c660 788 my $command = "gpg --keyserver pgp.mit.edu --always-trust --status-fd 2";
ca385da6
MT
789 system("$command --recv-key $myid >> $Conf::logdir/gnupg-database.log 2>&1");
790 system("$command --recv-key $trustid >> $Conf::logdir/gnupg-database.log 2>&1");
a6d327a7
MT
791 } else {
792 logger("CRYPTO INFO: Database is okay");
cde0e116
MT
793 }
794}
795
a6d327a7
MT
796sub callback {
797 my ($data, $response, $protocol) = @_;
798 $final_data .= $data;
35f38a8b 799 print progress_bar( length($final_data), $total_size, 30, '=' );
a6d327a7
MT
800}
801
802sub progress_bar {
803 my ( $got, $total, $width, $char ) = @_;
804 my $show_bfile;
35f38a8b 805 $width ||= 30; $char ||= '=';
a6d327a7 806 my $len_bfile = length $bfile;
35f38a8b
MT
807 if ("$len_bfile" >= "17") {
808 $show_bfile = substr($bfile,0,17)."...";
a6d327a7
MT
809 } else {
810 $show_bfile = $bfile;
35f38a8b
MT
811 }
812 $progress = sprintf("%.2f%%", 100*$got/+$total);
813 sprintf "$color{'lightgreen'}%-20s %7s |%-${width}s| %10s$color{'normal'}\r",$show_bfile, $progress, $char x (($width-1)*$got/$total). '>', beautifysize($got);
a6d327a7
MT
814}
815
1bd42c89 8161;