]> git.ipfire.org Git - ipfire-2.x.git/blame - src/pakfire/lib/functions.pl
core196: Ship man pages
[ipfire-2.x.git] / src / pakfire / lib / functions.pl
CommitLineData
1bd42c89 1#!/usr/bin/perl -w
70df8302
MT
2###############################################################################
3# #
4# IPFire.org - A linux based firewall #
2527b86e 5# Copyright (C) 2007-2025 IPFire Team <info@ipfire.org> #
70df8302
MT
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###############################################################################
1bd42c89
MT
21
22require "/opt/pakfire/etc/pakfire.conf";
4b122800 23require "/var/ipfire/general-functions.pl";
1bd42c89
MT
24
25use File::Basename;
26use File::Copy;
27use LWP::UserAgent;
4d504812 28use HTTP::Response;
a6d327a7
MT
29use HTTP::Headers;
30use HTTP::Message;
31use HTTP::Request;
1bd42c89 32use Net::Ping;
ec18a1ec 33use URI;
1bd42c89 34
66a0f364
PM
35use Switch;
36
1bd42c89
MT
37package Pakfire;
38
3e29608f
MT
39my @VALID_KEY_FINGERPRINTS = (
40 # 2018
41 "3ECA8AA4478208B924BB96206FEF7A8ED713594B",
42 # 2007
43 "179740DC4D8C47DC63C099C74BDE364C64D96617",
44);
45
35f38a8b 46# A small color-hash :D
0bd5b131 47our %color;
66c36198 48 $color{'normal'} = "\033[0m";
35f38a8b
MT
49 $color{'black'} = "\033[0;30m";
50 $color{'darkgrey'} = "\033[1;30m";
51 $color{'blue'} = "\033[0;34m";
52 $color{'lightblue'} = "\033[1;34m";
53 $color{'green'} = "\033[0;32m";
54 $color{'lightgreen'} = "\033[1;32m";
55 $color{'cyan'} = "\033[0;36m";
56 $color{'lightcyan'} = "\033[1;36m";
57 $color{'red'} = "\033[0;31m";
58 $color{'lightred'} = "\033[1;31m";
59 $color{'purple'} = "\033[0;35m";
60 $color{'lightpurple'} = "\033[1;35m";
61 $color{'brown'} = "\033[0;33m";
62 $color{'lightgrey'} = "\033[0;37m";
63 $color{'yellow'} = "\033[1;33m";
64 $color{'white'} = "\033[1;37m";
750c1528 65our $enable_colors = 1;
35f38a8b 66
a6d327a7
MT
67my $final_data;
68my $total_size;
69my $bfile;
70
4b122800
MT
71my %pakfiresettings = ();
72&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
73
e6f4991b
MT
74# Make version
75$Conf::version = &make_version();
76
d6c2e671
SS
77# Pakfire lock file.
78our $lockfile = "/tmp/pakfire_lock";
79
1bd42c89
MT
80sub message {
81 my $message = shift;
66c36198 82
1bd42c89 83 logger("$message");
750c1528
MT
84 if ( $enable_colors == 1 ) {
85 if ("$message" =~ /ERROR/) {
86 $message = "$color{'red'}$message$color{'normal'}";
87 } elsif ("$message" =~ /INFO/) {
88 $message = "$color{'cyan'}$message$color{'normal'}";
89 } elsif ("$message" =~ /WARN/) {
90 $message = "$color{'yellow'}$message$color{'normal'}";
91 } elsif ("$message" =~ /RESV/) {
92 $message = "$color{'purple'}$message$color{'normal'}";
93 } elsif ("$message" =~ /INST/) {
94 $message = "$color{'green'}$message$color{'normal'}";
95 } elsif ("$message" =~ /REMV/) {
96 $message = "$color{'lightred'}$message$color{'normal'}";
97 } elsif ("$message" =~ /UPGR/) {
98 $message = "$color{'lightblue'}$message$color{'normal'}";
99 }
35f38a8b
MT
100 }
101 print "$message\n";
66c36198 102
1bd42c89
MT
103}
104
105sub logger {
106 my $log = shift;
9ced24a8 107 if ($log) {
c506cad0 108 system("logger -t pakfire \"$log\"");
9ced24a8 109 }
1bd42c89
MT
110}
111
5b2a12ff 112sub usage {
acc61093
SC
113 &Pakfire::message("Usage: pakfire COMMAND [OPTIONS] [PACKAGE ...]");
114 &Pakfire::message("Manage IPFire add-on packages and updates.");
115 &Pakfire::message("PACKAGE:");
116 &Pakfire::message(" one or more add-on package names");
117 &Pakfire::message("COMMAND:");
118 &Pakfire::message(" install - install one or more packages");
119 &Pakfire::message(" remove - remove one or more packages");
120 &Pakfire::message(" update - update the pakfire database");
121 &Pakfire::message(" upgrade - upgrade all packages to the latest version");
122 &Pakfire::message(" list [installed | notinstalled | upgrade]");
123 &Pakfire::message(" - display a list of installed, notinstalled,");
124 &Pakfire::message(" upgradeable or all packages");
125 &Pakfire::message(" info - display metadata for one or more packages");
126 &Pakfire::message(" resolvedeps - display dependencies for one or more packages");
127 &Pakfire::message(" status - display pakfire database status,");
128 &Pakfire::message(" available updates and whether a reboot");
129 &Pakfire::message(" is required to complete any upgrades");
130 &Pakfire::message("OPTIONS:");
131 &Pakfire::message(" --no-colors - turn off colors");
132 &Pakfire::message(" -y | --non-interactive - automatic yes to prompts");
133 &Pakfire::message(" -f | --force - for the update command, force");
134 &Pakfire::message(" a pakfire database update");
750c1528 135 &Pakfire::message("");
5b2a12ff
MT
136 exit 1;
137}
138
1bd42c89 139sub fetchfile {
4d504812
MT
140 my $getfile = shift;
141 my $gethost = shift;
377560fb
MT
142 my (@server, $host, $proto, $file, $i);
143 my $allok = 0;
66c36198 144
1bd42c89 145 use File::Basename;
4d504812 146 $bfile = basename("$getfile");
66c36198 147
06d55142 148 logger("DOWNLOAD STARTED: $getfile");
1bd42c89 149
66c36198 150 $i = 0;
4d504812
MT
151 while (($allok == 0) && $i < 5) {
152 $i++;
66c36198 153
4d504812
MT
154 if ("$gethost" eq "") {
155 @server = selectmirror();
156 $proto = $server[0];
157 $host = $server[1];
158 $file = "$server[2]/$getfile";
1bd42c89 159 } else {
4d504812 160 $host = $gethost;
afabe9f7 161 $file = $getfile;
1bd42c89 162 }
66c36198 163
c846ed16 164 $proto = "HTTPS" unless $proto;
66c36198 165
06d55142 166 logger("DOWNLOAD INFO: Host: $host ($proto) - File: $file");
1bd42c89 167
53f7dc76
SS
168 # Init LWP::UserAgent, request SSL hostname verification
169 # and specify CA file.
170 my $ua = LWP::UserAgent->new(
171 ssl_opts => {
172 SSL_ca_file => '/etc/ssl/cert.pem',
173 verify_hostname => 1,
174 }
175 );
4d504812 176 $ua->agent("Pakfire/$Conf::version");
3d3b68c5 177 $ua->timeout(20);
66c36198 178
4b122800
MT
179 my %proxysettings=();
180 &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings);
181
99e6df8e 182 if ($proxysettings{'UPSTREAM_PROXY'}) {
06d55142 183 logger("DOWNLOAD INFO: Upstream proxy: \"$proxysettings{'UPSTREAM_PROXY'}\"");
4b122800 184 if ($proxysettings{'UPSTREAM_USER'}) {
d96d5db6 185 $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$proxysettings{'UPSTREAM_PROXY'}/");
cf33650e 186 logger("DOWNLOAD INFO: Logging in with \"$proxysettings{'UPSTREAM_USER'}\" against \"$proxysettings{'UPSTREAM_PROXY'}\"");
4b122800 187 } else {
d96d5db6 188 $ua->proxy(["http", "https"], "http://$proxysettings{'UPSTREAM_PROXY'}/");
4b122800
MT
189 }
190 }
a6d327a7
MT
191
192 $final_data = undef;
66a0f364
PM
193
194 my $url;
195 switch ($proto) {
196 case "HTTP" { $url = "http://$host/$file"; }
197 case "HTTPS" { $url = "https://$host/$file"; }
198 else {
199 # skip all lines with unknown protocols
200 logger("DOWNLOAD WARNING: Skipping Host: $host due to unknown protocol ($proto) in mirror database");
201 next;
202 }
203 }
204
06d55142
MT
205 my $result = $ua->head($url);
206 my $remote_headers = $result->headers;
207 $total_size = $remote_headers->content_length;
208 logger("DOWNLOAD INFO: $file has size of $total_size bytes");
66c36198 209
06d55142
MT
210 my $response = $ua->get($url, ':content_cb' => \&callback );
211 message("");
66c36198 212
4b122800
MT
213 my $code = $response->code();
214 my $log = $response->status_line;
a6d327a7 215 logger("DOWNLOAD INFO: HTTP-Status-Code: $code - $log");
66c36198 216
4d504812 217 if ($response->is_success) {
06d55142
MT
218 if (open(FILE, ">$Conf::tmpdir/$bfile")) {
219 print FILE $final_data;
220 close(FILE);
221 logger("DOWNLOAD INFO: File received. Start checking signature...");
222 if (&valid_signature("$Conf::tmpdir/$bfile")) {
223 logger("DOWNLOAD INFO: Signature of $bfile is fine.");
224 move("$Conf::tmpdir/$bfile","$Conf::cachedir/$bfile");
35f38a8b 225 } else {
06d55142
MT
226 message("DOWNLOAD ERROR: The downloaded file ($file) wasn't verified by IPFire.org. Sorry - Exiting...");
227 my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1`;
228 if ( $ntp !~ /time\ server(.*)offset(.*)/ ){message("TIME ERROR: Unable to get the nettime, this may lead to the verification error.");}
229 else { $ntp =~ /time\ server(.*)offset(.*)/; message("TIME INFO: Time Server$1has$2 offset to localtime.");}
230 exit 1;
186e3d2c 231 }
06d55142
MT
232 logger("DOWNLOAD FINISHED: $file");
233 $allok = 1;
8ce72945 234 return 1;
06d55142
MT
235 } else {
236 logger("DOWNLOAD ERROR: Could not open $Conf::tmpdir/$bfile for writing.");
4d504812 237 }
06d55142 238 } else {
a6d327a7 239 logger("DOWNLOAD ERROR: $log");
4d504812 240 }
1bd42c89 241 }
a6d327a7 242 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.");
8ce72945 243 return 0;
1bd42c89
MT
244}
245
246sub getmirrors {
377560fb
MT
247 my $force = shift;
248 my $age;
66c36198 249
1bd42c89 250 use File::Copy;
66c36198 251
2aa6d448
MT
252 if ( -e "$Conf::dbdir/lists/server-list.db" ) {
253 my @stat = stat("$Conf::dbdir/lists/server-list.db");
e3670217
MT
254 my $time = time();
255 $age = $time - $stat[9];
377560fb
MT
256 $force = "force" if ("$age" >= "3600");
257 logger("MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force");
e3670217
MT
258 } else {
259 # Force an update.
377560fb 260 $force = "force";
e3670217 261 }
66c36198 262
377560fb 263 if ("$force" eq "force") {
8ce72945
RR
264 if (fetchfile("$Conf::version/lists/server-list.db", "$Conf::mainserver")) {
265 move("$Conf::cachedir/server-list.db", "$Conf::dbdir/lists/server-list.db");
266 } elsif (! -e "$Conf::dbdir/lists/server-list.db" ) {
267 # if we end up with no server-list at all, return failure
268 return 0;
269 }
e3670217 270 }
8ce72945 271 return 1;
1bd42c89
MT
272}
273
2aa6d448 274sub getcoredb {
377560fb
MT
275 my $force = shift;
276 my $age;
66c36198 277
2aa6d448 278 use File::Copy;
66c36198 279
2aa6d448
MT
280 if ( -e "$Conf::dbdir/lists/core-list.db" ) {
281 my @stat = stat("$Conf::dbdir/lists/core-list.db");
282 my $time = time();
283 $age = $time - $stat[9];
377560fb
MT
284 $force = "force" if ("$age" >= "3600");
285 logger("CORE INFO: core-list.db is $age seconds old. - DEBUG: $force");
2aa6d448
MT
286 } else {
287 # Force an update.
377560fb 288 $force = "force";
2aa6d448 289 }
66c36198 290
377560fb 291 if ("$force" eq "force") {
8ce72945
RR
292 if (fetchfile("lists/core-list.db", "")) {
293 move("$Conf::cachedir/core-list.db", "$Conf::dbdir/lists/core-list.db");
294 }
2aa6d448
MT
295 }
296}
297
3e29608f
MT
298sub valid_signature($) {
299 my $filename = shift;
300
301 open(my $cmd, "gpg --verify --status-fd 1 \"$filename\" 2>/dev/null |");
302 while (<$cmd>) {
303 # Process valid signature lines
304 if (/VALIDSIG ([A-Z0-9]+)/) {
305 # Check if we know the key
306 foreach my $key (@VALID_KEY_FINGERPRINTS) {
307 # Signature is valid
308 return 1 if ($key eq $1);
309 }
310 }
311 }
312 close($cmd);
313
314 # Signature is invalid
315 return 0;
316}
2aa6d448 317
1bd42c89 318sub selectmirror {
ec18a1ec
MT
319 if (defined ${Conf::mirror}) {
320 my $uri = URI->new("${Conf::mirror}");
321
322 # Only accept HTTPS mirrors
323 if ($uri->scheme eq "https") {
324 return ("HTTPS", $uri->host, $uri->path . "/" . ${Conf::version});
325 } else {
326 message("MIRROR ERROR: Unsupported mirror: " . ${Conf::mirror});
327 }
328 }
329
1bd42c89
MT
330 ### Check if there is a current server list and read it.
331 # If there is no list try to get one.
8ce72945
RR
332 unless (open(FILE, "<$Conf::dbdir/lists/server-list.db")) {
333 unless (getmirrors("noforce")) {
334 message("MIRROR ERROR: Could not find or download a server list");
335 exit 1;
336 }
1bd42c89 337 }
8ce72945 338
1bd42c89
MT
339 my @lines = <FILE>;
340 close(FILE);
341
342 ### Count the number of the servers in the list
343 my $scount = 0;
e44b26cf 344 my @newlines;
1bd42c89 345 foreach (@lines) {
e44b26cf
MT
346 if ("$_" =~ /.*;.*;.*;/ ) {
347 push(@newlines,$_);
348 $scount++;
349 }
1bd42c89 350 }
a6d327a7 351 logger("MIRROR INFO: $scount servers found in list");
63efc01c
MT
352
353 if ($scount eq 0) {
354 logger("MIRROR INFO: Could not find any servers. Falling back to main server $Conf::mainserver");
c846ed16 355 return ("HTTPS", $Conf::mainserver, "/$Conf::version");
63efc01c
MT
356 }
357
1bd42c89
MT
358 ### Choose a random server and test if it is online
359 # If the check fails try a new server.
360 # This will never give up.
1bd42c89 361 my $servers = 0;
e32591e7 362 while (1) {
1bd42c89
MT
363 $server = int(rand($scount) + 1);
364 $servers = 0;
365 my ($line, $proto, $path, $host);
366 my @templine;
e44b26cf 367 foreach $line (@newlines) {
1bd42c89
MT
368 $servers++;
369 if ($servers eq $server) {
370 @templine = split(/\;/, $line);
371 $proto = $templine[0];
372 $host = $templine[1];
373 $path = $templine[2];
e32591e7
MT
374
375 return ($proto, $host, $path);
1bd42c89
MT
376 }
377 }
4d504812 378 }
1bd42c89
MT
379}
380
381sub dbgetlist {
382 ### Update the database if the file is older than one day.
383 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
384 # Usage is always with an argument.
385 my $force = shift;
386 my $age;
66c36198 387
1bd42c89 388 use File::Copy;
66c36198 389
1bd42c89
MT
390 if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
391 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
392 my $time = time();
393 $age = $time - $stat[9];
377560fb
MT
394 $force = "force" if ("$age" >= "3600");
395 logger("DB INFO: packages_list.db is $age seconds old. - DEBUG: $force");
1bd42c89
MT
396 } else {
397 # Force an update.
377560fb 398 $force = "force";
1bd42c89 399 }
66c36198 400
377560fb 401 if ("$force" eq "force") {
8ce72945
RR
402 if (fetchfile("lists/packages_list.db", "")) {
403 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
404 } elsif ( -e "$Conf::dbdir/lists/packages_list.db" ) {
405 # If we end up with no db file after download error there
406 # is nothing more we can do here.
407 return 0;
408 }
1bd42c89 409 }
ff9545f8
AF
410
411 # Update the meta database if new packages was in the package list
ff9545f8
AF
412 my $file;
413 my $line;
414 my $prog;
847df41d 415 my %metadata;
ff9545f8
AF
416 my @templine;
417
c6d055a8 418 my %paklist = &Pakfire::dblist("all");
ff9545f8
AF
419
420 opendir(DIR,"$Conf::dbdir/meta");
421 my @files = readdir(DIR);
422 closedir(DIR);
423 foreach $file (@files) {
424 next if ( $file eq "." );
425 next if ( $file eq ".." );
1af34aa8 426 next if ( $file eq "meta-" );
ff9545f8 427 next if ( $file =~ /^old/ );
847df41d
RR
428 %metadata = parsemetafile("$Conf::dbdir/meta/$file");
429
c6d055a8
RR
430 if ((defined $paklist{"$metadata{'Name'}"}) && (
431 ("$paklist{\"$metadata{'Name'}\"}{'Release'}" ne "$metadata{'Release'}") ||
432 (defined $paklist{"$metadata{'Name'}"}{'AvailableRelease'}))
433 ) {
434 move("$Conf::dbdir/meta/meta-$metadata{'Name'}","$Conf::dbdir/meta/old_meta-$metadata{'Name'}");
435 getmetafile($metadata{'Name'});
ff9545f8
AF
436 }
437 }
1bd42c89
MT
438}
439
0bd5b131
RR
440sub coredbinfo {
441 ### This subroutine returns core db version information in a hash.
442 # Usage is without arguments
443
444 eval(`grep "core_" $Conf::dbdir/lists/core-list.db`);
445
446 my %coredb = (
447 CoreVersion => $Conf::version,
448 Release => $Conf::core_mine,
449 );
450
451 $coredb{'AvailableRelease'} = $core_release if ("$Conf::core_mine" < "$core_release");
452
453 return %coredb;
454}
455
1bd42c89 456sub dblist {
0bd5b131
RR
457 ### This subroutine returns the packages from the packages_list db in a hash.
458 # It uses the currently cached version of packages_list. To ensure latest
459 # data, run Pakfire::dbgetlist first.
460 # You may also pass a filter: &Pakfire::dblist(filter)
461 # Usage is always with one argument.
462 # filter may be:
463 # - "all": list all known paks,
464 # - "notinstalled": list only not installed paks,
465 # - "installed": list only installed paks
466 # - "upgrade": list only upgradable paks
467 #
468 # Returned hash format:
469 # ( "<pak name>" => (
470 # "Installed" => "Yes" or "No" wether the pak is installed,
471 # "ProgVersion" => Installed program version when "Installed" => "Yes" or
472 # Available version when "Installed" => No,
473 # "Release" => Installed pak release number when "Installed" => "Yes" or
474 # Available pak release number when "Installed" => No,
475 # "AvailableProgVersion" => Available program version.
476 # Only defined if an upgrade to a higher version is available,
477 # "AvailableRelease" => Available pak release version.
478 # Only defined if an upgrade to a higher version is available
479 # ),
480 # ...
481 # )
482
1bd42c89 483 my $filter = shift;
0bd5b131 484 my %paklist = ();
4b122800
MT
485 my $file;
486 my $line;
847df41d 487 my %metadata;
4b122800 488 my @templine;
0bd5b131 489
1bd42c89
MT
490 open(FILE, "<$Conf::dbdir/lists/packages_list.db");
491 my @db = <FILE>;
492 close(FILE);
4b122800 493
0bd5b131 494 if ("$filter" ne "notinstalled") {
5e932bd5 495 opendir(DIR,"$Conf::dbdir/installed");
4b122800
MT
496 my @files = readdir(DIR);
497 closedir(DIR);
0bd5b131 498
4b122800
MT
499 foreach $file (@files) {
500 next if ( $file eq "." );
501 next if ( $file eq ".." );
3f01107b 502 next if ( $file =~ /^old/ );
847df41d
RR
503 %metadata = parsemetafile("$Conf::dbdir/installed/$file");
504
0bd5b131
RR
505 foreach $line (@db) {
506 next unless ($line =~ /.*;.*;.*;/ );
507 @templine = split(/\;/,$line);
508 if (("$metadata{'Name'}" eq "$templine[0]") && ("$metadata{'Release'}" < "$templine[2]")) {
509 # Add all upgradable paks to list
510 $paklist{"$metadata{'Name'}"} = {
511 ProgVersion => $metadata{'ProgVersion'},
512 Release => $metadata{'Release'},
513 AvailableProgVersion => $templine[1],
514 AvailableRelease => $templine[2],
515 Installed => "yes"
516 };
517 last;
518 } elsif (("$metadata{'Name'}" eq "$templine[0]") && ("$filter" ne "upgrade")) {
519 # Add installed paks without an upgrade available to list
520 $paklist{"$metadata{'Name'}"} = {
521 ProgVersion => $metadata{'ProgVersion'},
522 Release => $metadata{'Release'},
523 Installed => "yes"
524 };
525 last;
4b122800
MT
526 }
527 }
5b2a12ff 528 }
0bd5b131
RR
529 }
530
531 # Add all not installed paks to list
532 if (("$filter" ne "upgrade") && ("$filter" ne "installed")) {
533 foreach $line (@db) {
06209efc 534 next unless ($line =~ /.*;.*;.*;/ );
4b122800 535 @templine = split(/\;/,$line);
0bd5b131
RR
536 next if ((defined $paklist{"$templine[0]"}) || (&isinstalled($templine[0]) == 0));
537
538 $paklist{"$templine[0]"} = {
539 ProgVersion => "$templine[1]",
540 Release => "$templine[2]",
541 Installed => "no"
542 };
1bd42c89
MT
543 }
544 }
0bd5b131
RR
545
546 return %paklist;
1bd42c89
MT
547}
548
621dcd86 549sub resolvedeps_one {
1bd42c89 550 my $pak = shift;
8ce72945 551
35f38a8b 552 message("PAKFIRE RESV: $pak: Resolving dependencies...");
66c36198 553
8ce72945
RR
554 unless (getmetafile("$pak")) {
555 message("PAKFIRE ERROR: Error retrieving dependency information on $pak. Unable to resolve dependencies.");
556 exit 1;
557 };
558
847df41d
RR
559 my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
560 my @all;
561 my @deps = split(/ /, $metadata{'Dependencies'});
1bd42c89
MT
562 chomp (@deps);
563 foreach (@deps) {
564 if ($_) {
186e3d2c
MT
565 my $return = &isinstalled($_);
566 if ($return eq 0) {
35f38a8b 567 message("PAKFIRE RESV: $pak: Dependency is already installed: $_");
186e3d2c 568 } else {
35f38a8b 569 message("PAKFIRE RESV: $pak: Need to install dependency: $_");
186e3d2c 570 push(@all,$_);
66c36198 571 }
1bd42c89
MT
572 }
573 }
e44b26cf 574
621dcd86
MT
575 return @all;
576}
577
578sub 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);
1bd42c89
MT
601 }
602 }
603 }
621dcd86 604
186e3d2c 605 return @all;
1bd42c89
MT
606}
607
9f1f68f1 608sub resolvedeps_recursive {
031becc0 609 my @packages = @_;
9f1f68f1
MT
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
1bd42c89
MT
627sub cleanup {
628 my $dir = shift;
629 my $path;
66c36198 630
35f38a8b 631 logger("CLEANUP: $dir");
66c36198 632
1bd42c89
MT
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
649sub getmetafile {
650 my $pak = shift;
8ce72945
RR
651
652 # Try to download meta-file if we don't have one yet, or it is empty for some reason
653 if ((! -e "$Conf::dbdir/meta/meta-$pak" ) || ( -z "$Conf::dbdir/meta/meta-$pak" )) {
654 return 0 unless (fetchfile("meta/meta-$pak", ""));
1bd42c89
MT
655 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
656 }
66c36198 657
1bd42c89
MT
658 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
659 my @line = <FILE>;
660 close(FILE);
66c36198 661
1bd42c89
MT
662 open(FILE, ">$Conf::dbdir/meta/meta-$pak");
663 foreach (@line) {
664 my $string = $_;
665 $string =~ s/\r\n/\n/g;
666 print FILE $string;
667 }
668 close(FILE);
8ce72945 669
1bd42c89
MT
670 return 1;
671}
672
673sub getsize {
674 my $pak = shift;
66c36198 675
1bd42c89 676 getmetafile("$pak");
66c36198 677
847df41d
RR
678 if (my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak")) {
679 return $metadata{'Size'};
680 }
681 return 0;
682}
683
684sub parsemetafile {
685 ### This subroutine returns a hash with the contents of a meta- file
686 # Pass path to metafile as argument: Pakfire::parsemetafile("$Conf::dbdir/meta/meta-$pak")
687 # Usage is always with an argument.
688 my $metafile = shift;
689
690 my %metadata = ();
691
692 my @templine;
693 my @file;
694
695 if (! -e $metafile ) {
696 return 0;
697 }
698
699 open(FILE, "<$metafile");
700 @file = <FILE>;
1bd42c89 701 close(FILE);
66c36198 702
847df41d
RR
703 foreach (@file) {
704 @templine = split(/\: /,$_);
705 if ($templine[1]) {
1bd42c89 706 chomp($templine[1]);
847df41d 707 $metadata{"$templine[0]"} = $templine[1];
1bd42c89
MT
708 }
709 }
847df41d
RR
710
711 return %metadata;
1bd42c89
MT
712}
713
2be67e38
RR
714sub getmetadata {
715 ### This subroutine returns a hash of available info for a package
716 # Pass package name and type of info as argument: Pakfire::getmetadata(package, type_of_info)
717 # Type_of_info can be "latest" or "installed"
718 # Usage is always with two argument.
719 my ($pak, $type) = @_;
720
721 my %metadata = (
722 Name => $pak,
723 Installed => "no",
724 Available => "no");
725 my %installed_metadata = ();
726
727 my @templine;
728 my @file;
729
730 ### Get available version information
731 if ("$type" eq "latest") {
732 ### Check if package is in packages_list and get latest available version
733 my %db = Pakfire::dblist("all");
734
735 if (defined $db{$pak}) {
736 ### Get and parse latest available metadata
737 if (getmetafile("$pak")) {
738 %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
739
740 $metadata{'Available'} = "yes";
741 ### Rename version info fields
742 $metadata{'AvailableProgVersion'} = delete $metadata{'ProgVersion'};
743 $metadata{'AvailableRelease'} = delete $metadata{'Release'};
744 }
745 }
746 }
747
748 ### Parse installed pak metadata
749 if (&isinstalled($pak) == 0) {
750 %installed_metadata = parsemetafile("$Conf::dbdir/installed/meta-$pak");
751
752 if ("$type" eq "latest" && exists($metadata{'AvailableProgVersion'})) {
753 ### Add installed version info to latest metadata
754 $metadata{'ProgVersion'} = $installed_metadata{'ProgVersion'};
755 $metadata{'Release'} = $installed_metadata{'Release'};
756 } else {
757 ### Use metadata of installed pak
758 %metadata = %installed_metadata;
759 }
760 $metadata{'Installed'} = 'yes';
761 } else {
762 $metadata{'Installed'} = 'no';
763 }
764
765 return %metadata;
766}
767
1bd42c89
MT
768sub decryptpak {
769 my $pak = shift;
66c36198 770
1bd42c89 771 cleanup("tmp");
66c36198 772
1bd42c89 773 my $file = getpak("$pak", "noforce");
66c36198 774
a6d327a7 775 logger("DECRYPT STARTED: $pak");
35f38a8b 776 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 777 $return %= 255;
a6d327a7 778 logger("DECRYPT FINISHED: $pak - Status: $return");
cde0e116 779 if ($return != 0) { exit 1; }
1bd42c89
MT
780}
781
782sub getpak {
783 my $pak = shift;
784 my $force = shift;
785
8ce72945
RR
786 unless (getmetafile("$pak")) {
787 message("PAKFIRE ERROR: Unable to retrieve $pak metadata.");
788 exit 1;
789 }
790
847df41d
RR
791 my %metadata = parsemetafile("$Conf::dbdir/meta/meta-$pak");
792 my $file = $metadata{'File'};
66c36198 793
1bd42c89 794 unless ($file) {
1af34aa8 795 message("No filename given in meta-file.");
1bd42c89
MT
796 exit 1;
797 }
66c36198 798
1bd42c89
MT
799 unless ( "$force" eq "force" ) {
800 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
801 return $file;
802 }
803 }
8ce72945
RR
804
805 unless (fetchfile("paks/$file", "")) {
806 message("PAKFIRE ERROR: Unable to download $pak.");
807 exit 1;
808 }
1bd42c89
MT
809 return $file;
810}
811
812sub setuppak {
813 my $pak = shift;
66c36198 814
35f38a8b 815 message("PAKFIRE INST: $pak: Decrypting...");
1bd42c89 816 decryptpak("$pak");
66c36198 817
35f38a8b 818 message("PAKFIRE INST: $pak: Copying files and running post-installation scripts...");
99e6df8e 819 my $return = system("cd $Conf::tmpdir && NAME=$pak ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
cde0e116 820 $return %= 255;
1bd42c89
MT
821 if ($return == 0) {
822 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
823 cleanup("tmp");
4d504812 824 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
35f38a8b
MT
825 message("PAKFIRE INST: $pak: Finished.");
826 message("");
1bd42c89 827 } else {
35f38a8b 828 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
1bd42c89
MT
829 exit $return;
830 }
a08c3a2e 831 return $return;
1bd42c89
MT
832}
833
2aa6d448 834sub upgradecore {
5e1dbc95
RR
835 # Safety check for lazy testers:
836 # Before we upgrade to the latest release, we re-install the previous release
837 # to make sure that the tester has always been on the latest version.
838 my $tree = &get_tree();
839 $Conf::core_mine-- if ($tree eq "testing" || $tree eq "unstable");
66c36198 840
5e1dbc95
RR
841 message("CORE UPGR: Upgrading from release $Conf::core_mine to $core_release");
842
843 my @seq = ($Conf::core_mine .. $core_release);
844 shift @seq;
845 my $release;
846 foreach $release (@seq) {
847 chomp($release);
848 getpak("core-upgrade-$release");
2aa6d448 849 }
5e1dbc95
RR
850
851 foreach $release (@seq) {
852 chomp($release);
853 upgradepak("core-upgrade-$release");
854 }
855
856 system("echo $core_release > $Conf::coredir/mine");
2aa6d448
MT
857}
858
186e3d2c
MT
859sub isinstalled {
860 my $pak = shift;
861 if ( open(FILE,"<$Conf::dbdir/installed/meta-$pak") ) {
862 close(FILE);
863 return 0;
864 } else {
865 return 1;
866 }
867}
868
99e6df8e 869sub upgradepak {
1bd42c89
MT
870 my $pak = shift;
871
35f38a8b 872 message("PAKFIRE UPGR: $pak: Decrypting...");
1bd42c89
MT
873 decryptpak("$pak");
874
35f38a8b 875 message("PAKFIRE UPGR: $pak: Upgrading files and running post-upgrading scripts...");
99e6df8e
MT
876 my $return = system("cd $Conf::tmpdir && NAME=$pak ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
877 $return %= 255;
1bd42c89
MT
878 if ($return == 0) {
879 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
880 cleanup("tmp");
4e4b54c5 881 copy("$Conf::dbdir/meta/meta-$pak", "$Conf::dbdir/installed/");
35f38a8b
MT
882 message("PAKFIRE UPGR: $pak: Finished.");
883 message("");
1bd42c89 884 } else {
35f38a8b 885 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
1bd42c89
MT
886 exit $return;
887 }
8e58bd37 888 return $return;
1bd42c89
MT
889}
890
891sub removepak {
892 my $pak = shift;
893
35f38a8b 894 message("PAKFIRE REMV: $pak: Decrypting...");
1bd42c89
MT
895 decryptpak("$pak");
896
35f38a8b 897 message("PAKFIRE REMV: $pak: Removing files and running post-removing scripts...");
99e6df8e
MT
898 my $return = system("cd $Conf::tmpdir && NAME=$pak ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
899 $return %= 255;
1bd42c89 900 if ($return == 0) {
1bd42c89 901 unlink("$Conf::dbdir/rootfiles/$pak");
a6d327a7 902 unlink("$Conf::dbdir/installed/meta-$pak");
1bd42c89 903 cleanup("tmp");
35f38a8b
MT
904 message("PAKFIRE REMV: $pak: Finished.");
905 message("");
1bd42c89 906 } else {
35f38a8b 907 message("PAKFIRE ERROR: Returncode: $return. Sorry. Please search our forum to find a solution for this problem.");
1bd42c89
MT
908 exit $return;
909 }
8e58bd37 910 return $return;
1bd42c89
MT
911}
912
913sub beautifysize {
914 my $size = shift;
35f38a8b 915 #$size = $size / 1024;
a08c3a2e 916 my $unit;
66c36198 917
35f38a8b
MT
918 if ($size > 1023*1024) {
919 $size = ($size / (1024*1024));
a08c3a2e 920 $unit = "MB";
35f38a8b
MT
921 } elsif ($size > 1023) {
922 $size = ($size / 1024);
a08c3a2e 923 $unit = "KB";
35f38a8b
MT
924 } else {
925 $unit = "B";
1bd42c89 926 }
a08c3a2e
MT
927 $size = sprintf("%.2f" , $size);
928 my $string = "$size $unit";
929 return $string;
1bd42c89
MT
930}
931
8e58bd37
MT
932sub makeuuid {
933 unless ( -e "$Conf::dbdir/uuid" ) {
8e58bd37
MT
934 open(FILE, "</proc/sys/kernel/random/uuid");
935 my @line = <FILE>;
936 close(FILE);
66c36198 937
8e58bd37
MT
938 open(FILE, ">$Conf::dbdir/uuid");
939 foreach (@line) {
940 print FILE $_;
941 }
942 close(FILE);
943 }
944}
945
a6d327a7
MT
946sub callback {
947 my ($data, $response, $protocol) = @_;
948 $final_data .= $data;
35f38a8b 949 print progress_bar( length($final_data), $total_size, 30, '=' );
a6d327a7
MT
950}
951
952sub progress_bar {
953 my ( $got, $total, $width, $char ) = @_;
954 my $show_bfile;
35f38a8b 955 $width ||= 30; $char ||= '=';
a6d327a7 956 my $len_bfile = length $bfile;
35f38a8b
MT
957 if ("$len_bfile" >= "17") {
958 $show_bfile = substr($bfile,0,17)."...";
a6d327a7
MT
959 } else {
960 $show_bfile = $bfile;
66c36198 961 }
35f38a8b
MT
962 $progress = sprintf("%.2f%%", 100*$got/+$total);
963 sprintf "$color{'lightgreen'}%-20s %7s |%-${width}s| %10s$color{'normal'}\r",$show_bfile, $progress, $char x (($width-1)*$got/$total). '>', beautifysize($got);
a6d327a7
MT
964}
965
090af02e
AK
966sub updates_available {
967 # Get packets with updates available
0bd5b131 968 my %upgradepaks = &Pakfire::dblist("upgrade");
090af02e 969
0bd5b131
RR
970 # Get the length of the returned hash
971 my $updatecount = keys %upgradepaks;
090af02e
AK
972
973 return "$updatecount";
974}
975
090af02e
AK
976sub reboot_required {
977 if ( -e "/var/run/need_reboot" ) {
978 return "yes";
979 }
980 else {
981 return "no";
982 }
983}
984
985sub status {
074b5097
RR
986 ### This subroutine returns pakfire status information in a hash.
987 # Usage is without arguments
988
989 # Add core version info
990 my %status = &Pakfire::coredbinfo();
991
992 # Add last update info
993 $status{'LastUpdate'} = &General::age("/opt/pakfire/db/core/mine");
994 $status{'LastCoreListUpdate'} = &General::age("/opt/pakfire/db/lists/core-list.db");
995 $status{'LastServerListUpdate'} = &General::age("/opt/pakfire/db/lists/server-list.db");
996 $status{'LastPakListUpdate'} = &General::age("/opt/pakfire/db/lists/packages_list.db");
997
998 # Add number of available package updates
999 $status{'CoreUpdateAvailable'} = (defined $status{'AvailableRelease'}) ? "yes" : "no";
1000 $status{'PakUpdatesAvailable'} = &Pakfire::updates_available();
1001
1002 # Add if reboot is required
1003 $status{'RebootRequired'} = &Pakfire::reboot_required();
1004
1005 return %status;
090af02e
AK
1006}
1007
e6f4991b
MT
1008sub get_arch() {
1009 # Append architecture
1010 my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
1011
e6f4991b
MT
1012 return $machine;
1013}
1014
152378c6
MT
1015sub get_tree() {
1016 # Return stable if nothing is set
1017 return "stable" unless (defined $pakfiresettings{'TREE'});
1018
1019 return $pakfiresettings{'TREE'};
1020}
1021
e6f4991b
MT
1022sub make_version() {
1023 my $version = "";
1024
1025 # Open /etc/system-release
1026 open(RELEASE, "</etc/system-release");
1027 my $release = <RELEASE>;
1028 close(RELEASE);
1029
1030 # Add the main relase
1031 if ($release =~ m/IPFire ([\d\.]+)/) {
1032 $version .= $1;
1033 }
1034
152378c6
MT
1035 # Append suffix for tree
1036 my $tree = &get_tree();
1037 if ($tree eq "testing") {
1038 $version .= ".1";
1039 } elsif ($tree eq "unstable") {
1040 $version .= ".2";
1041 }
1042
e6f4991b 1043 # Append architecture
6cf219c4 1044 $version .= "-" . &get_arch();
e6f4991b
MT
1045
1046 return $version;
1047}
1048
1bd42c89 10491;