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