]>
git.ipfire.org Git - ipfire-2.x.git/blob - src/pakfire/lib/functions.pl
e623e8bc3f3fcb5937e7d59e4d6c63745fee6a58
2 ###############################################################################
4 # IPFire.org - A linux based firewall #
5 # Copyright (C) 2007-2022 IPFire Team <info@ipfire.org> #
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. #
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. #
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/>. #
20 ###############################################################################
22 require "/opt/pakfire/etc/pakfire.conf" ;
23 require "/var/ipfire/general-functions.pl" ;
39 my @VALID_KEY_FINGERPRINTS = (
41 "3ECA8AA4478208B924BB96206FEF7A8ED713594B" ,
43 "179740DC4D8C47DC63C099C74BDE364C64D96617" ,
46 # A small color-hash :D
48 $color { 'normal' } = " \033 [0m" ;
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" ;
65 our $enable_colors = 1 ;
71 my %pakfiresettings = ();
72 & General
:: readhash
( "${General::swroot}/pakfire/settings" , \
%pakfiresettings );
75 $Conf :: version
= & make_version
();
78 our $lockfile = "/tmp/pakfire_lock" ;
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'}" ;
108 #system("echo \"`date`: $log\" >> /var/log/pakfire.log");
109 system ( "logger -t pakfire \" $log \" " );
114 & Pakfire
:: message
( "Usage: pakfire <install|remove> [options] <pak(s)>" );
115 & Pakfire
:: message
( " <update> - Contacts the servers for new lists of paks." );
116 & Pakfire
:: message
( " <upgrade> - Installs the latest version of all paks." );
117 & Pakfire
:: message
( " <list> [installed/notinstalled/upgrade] - Outputs a list with all, installed, available or upgradeable paks." );
118 & Pakfire
:: message
( " <info> <pak> [<pak> ...] - Output pak metadata." );
119 & Pakfire
:: message
( " <status> - Outputs a summary about available core upgrades, updates and a required reboot" );
120 & Pakfire
:: message
( "" );
121 & Pakfire
:: message
( " Global options:" );
122 & Pakfire
:: message
( " --non-interactive --> Enables the non-interactive mode." );
123 & Pakfire
:: message
( " You won't see any question here." );
124 & Pakfire
:: message
( " -y --> Short for --non-interactive." );
125 & Pakfire
:: message
( " --no-colors --> Turns off the wonderful colors." );
126 & Pakfire
:: message
( "" );
133 my ( @server , $host , $proto , $file , $i );
137 $bfile = basename
( " $getfile " );
139 logger
( "DOWNLOAD STARTED: $getfile " );
142 while (( $allok == 0 ) && $i < 5 ) {
145 if ( " $gethost " eq "" ) {
146 @server = selectmirror
();
149 $file = " $server [2]/ $getfile " ;
155 $proto = "HTTPS" unless $proto ;
157 logger
( "DOWNLOAD INFO: Host: $host ( $proto ) - File: $file " );
159 # Init LWP::UserAgent, request SSL hostname verification
160 # and specify CA file.
161 my $ua = LWP
:: UserAgent
-> new (
163 SSL_ca_file
=> '/etc/ssl/cert.pem' ,
164 verify_hostname
=> 1 ,
167 $ua -> agent ( "Pakfire/ $Conf ::version" );
170 my %proxysettings =();
171 & General
:: readhash
( "${General::swroot}/proxy/advanced/settings" , \
%proxysettings );
173 if ( $proxysettings { 'UPSTREAM_PROXY' }) {
174 logger
( "DOWNLOAD INFO: Upstream proxy: \" $proxysettings {'UPSTREAM_PROXY'} \" " );
175 if ( $proxysettings { 'UPSTREAM_USER' }) {
176 $ua -> proxy ([ "http" , "https" ], "http:// $proxysettings {'UPSTREAM_USER'}: $proxysettings {'UPSTREAM_PASSWORD'}@" . " $proxysettings {'UPSTREAM_PROXY'}/" );
177 logger
( "DOWNLOAD INFO: Logging in with \" $proxysettings {'UPSTREAM_USER'} \" against \" $proxysettings {'UPSTREAM_PROXY'} \" " );
179 $ua -> proxy ([ "http" , "https" ], "http:// $proxysettings {'UPSTREAM_PROXY'}/" );
187 case
"HTTP" { $url = "http:// $host / $file " ; }
188 case
"HTTPS" { $url = "https:// $host / $file " ; }
190 # skip all lines with unknown protocols
191 logger
( "DOWNLOAD WARNING: Skipping Host: $host due to unknown protocol ( $proto ) in mirror database" );
196 my $result = $ua -> head ( $url );
197 my $remote_headers = $result -> headers ;
198 $total_size = $remote_headers -> content_length ;
199 logger
( "DOWNLOAD INFO: $file has size of $total_size bytes" );
201 my $response = $ua -> get ( $url , ':content_cb' => \
& callback
);
204 my $code = $response -> code ();
205 my $log = $response -> status_line ;
206 logger
( "DOWNLOAD INFO: HTTP-Status-Code: $code - $log " );
208 if ( $response -> is_success ) {
209 if ( open ( FILE
, "> $Conf ::tmpdir/ $bfile " )) {
210 print FILE
$final_data ;
212 logger
( "DOWNLOAD INFO: File received. Start checking signature..." );
213 if (& valid_signature
( " $Conf ::tmpdir/ $bfile " )) {
214 logger
( "DOWNLOAD INFO: Signature of $bfile is fine." );
215 move
( " $Conf ::tmpdir/ $bfile " , " $Conf ::cachedir/ $bfile " );
217 message
( "DOWNLOAD ERROR: The downloaded file ( $file ) wasn't verified by IPFire.org. Sorry - Exiting..." );
218 my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1` ;
219 if ( $ntp !~ /time\ server(.*)offset(.*)/ ){ message
( "TIME ERROR: Unable to get the nettime, this may lead to the verification error." );}
220 else { $ntp =~ /time\ server(.*)offset(.*)/ ; message
( "TIME INFO: Time Server $1has $2 offset to localtime." );}
223 logger
( "DOWNLOAD FINISHED: $file " );
227 logger
( "DOWNLOAD ERROR: Could not open $Conf ::tmpdir/ $bfile for writing." );
230 logger
( "DOWNLOAD ERROR: $log " );
233 message
( "DOWNLOAD ERROR: There was no chance to get the file \" $getfile \" from any available server. \n May be you should run \" pakfire update \" to get some new servers." );
243 if ( - e
" $Conf ::dbdir/lists/server-list.db" ) {
244 my @stat = stat ( " $Conf ::dbdir/lists/server-list.db" );
246 $age = $time - $stat [ 9 ];
247 $force = "force" if ( " $age " >= "3600" );
248 logger
( "MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force " );
254 if ( " $force " eq "force" ) {
255 if ( fetchfile
( " $Conf ::version/lists/server-list.db" , " $Conf ::mainserver" )) {
256 move
( " $Conf ::cachedir/server-list.db" , " $Conf ::dbdir/lists/server-list.db" );
257 } elsif (! - e
" $Conf ::dbdir/lists/server-list.db" ) {
258 # if we end up with no server-list at all, return failure
271 if ( - e
" $Conf ::dbdir/lists/core-list.db" ) {
272 my @stat = stat ( " $Conf ::dbdir/lists/core-list.db" );
274 $age = $time - $stat [ 9 ];
275 $force = "force" if ( " $age " >= "3600" );
276 logger
( "CORE INFO: core-list.db is $age seconds old. - DEBUG: $force " );
282 if ( " $force " eq "force" ) {
283 if ( fetchfile
( "lists/core-list.db" , "" )) {
284 move
( " $Conf ::cachedir/core-list.db" , " $Conf ::dbdir/lists/core-list.db" );
289 sub valid_signature
($) {
290 my $filename = shift ;
292 open ( my $cmd , "gpg --verify --status-fd 1 \" $filename \" 2>/dev/null |" );
294 # Process valid signature lines
295 if ( /VALIDSIG ([A-Z0-9]+)/ ) {
296 # Check if we know the key
297 foreach my $key ( @VALID_KEY_FINGERPRINTS ) {
299 return 1 if ( $key eq $1 );
305 # Signature is invalid
310 if ( defined ${ Conf
:: mirror
}) {
311 my $uri = URI
-> new ( "${Conf::mirror}" );
313 # Only accept HTTPS mirrors
314 if ( $uri -> scheme eq "https" ) {
315 return ( "HTTPS" , $uri -> host , $uri -> path . "/" . ${ Conf
:: version
});
317 message
( "MIRROR ERROR: Unsupported mirror: " . ${ Conf
:: mirror
});
321 ### Check if there is a current server list and read it.
322 # If there is no list try to get one.
323 unless ( open ( FILE
, "< $Conf ::dbdir/lists/server-list.db" )) {
324 unless ( getmirrors
( "noforce" )) {
325 message
( "MIRROR ERROR: Could not find or download a server list" );
333 ### Count the number of the servers in the list
337 if ( " $_ " =~ /.*;.*;.*;/ ) {
342 logger
( "MIRROR INFO: $scount servers found in list" );
345 logger
( "MIRROR INFO: Could not find any servers. Falling back to main server $Conf ::mainserver" );
346 return ( "HTTPS" , $Conf :: mainserver
, "/ $Conf ::version" );
349 ### Choose a random server and test if it is online
350 # If the check fails try a new server.
351 # This will never give up.
354 $server = int ( rand ( $scount ) + 1 );
356 my ( $line , $proto , $path , $host );
358 foreach $line ( @newlines ) {
360 if ( $servers eq $server ) {
361 @templine = split ( /\;/ , $line );
362 $proto = $templine [ 0 ];
363 $host = $templine [ 1 ];
364 $path = $templine [ 2 ];
366 return ( $proto , $host , $path );
373 ### Update the database if the file is older than one day.
374 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
375 # Usage is always with an argument.
381 if ( - e
" $Conf ::dbdir/lists/packages_list.db" ) {
382 my @stat = stat ( " $Conf ::dbdir/lists/packages_list.db" );
384 $age = $time - $stat [ 9 ];
385 $force = "force" if ( " $age " >= "3600" );
386 logger
( "DB INFO: packages_list.db is $age seconds old. - DEBUG: $force " );
392 if ( " $force " eq "force" ) {
393 if ( fetchfile
( "lists/packages_list.db" , "" )) {
394 move
( " $Conf ::cachedir/packages_list.db" , " $Conf ::dbdir/lists/packages_list.db" );
395 } elsif ( - e
" $Conf ::dbdir/lists/packages_list.db" ) {
396 # If we end up with no db file after download error there
397 # is nothing more we can do here.
402 # Update the meta database if new packages was in the package list
409 my %paklist = & Pakfire
:: dblist
( "all" );
411 opendir ( DIR
, " $Conf ::dbdir/meta" );
412 my @files = readdir ( DIR
);
414 foreach $file ( @files ) {
415 next if ( $file eq "." );
416 next if ( $file eq ".." );
417 next if ( $file eq "meta-" );
418 next if ( $file =~ /^old/ );
419 %metadata = parsemetafile
( " $Conf ::dbdir/meta/ $file " );
421 if (( defined $paklist { " $metadata {'Name'}" }) && (
422 ( " $paklist { \" $metadata {'Name'} \" }{'Release'}" ne " $metadata {'Release'}" ) ||
423 ( defined $paklist { " $metadata {'Name'}" }{ 'AvailableRelease' }))
425 move
( " $Conf ::dbdir/meta/meta- $metadata {'Name'}" , " $Conf ::dbdir/meta/old_meta- $metadata {'Name'}" );
426 getmetafile
( $metadata { 'Name' });
432 ### This subroutine returns core db version information in a hash.
433 # Usage is without arguments
435 eval ( `grep "core_" $Conf ::dbdir/lists/core-list.db` );
438 CoreVersion
=> $Conf :: version
,
439 Release
=> $Conf :: core_mine
,
442 $coredb { 'AvailableRelease' } = $core_release if ( " $Conf ::core_mine" < " $core_release " );
448 ### This subroutine returns the packages from the packages_list db in a hash.
449 # It uses the currently cached version of packages_list. To ensure latest
450 # data, run Pakfire::dbgetlist first.
451 # You may also pass a filter: &Pakfire::dblist(filter)
452 # Usage is always with one argument.
454 # - "all": list all known paks,
455 # - "notinstalled": list only not installed paks,
456 # - "installed": list only installed paks
457 # - "upgrade": list only upgradable paks
459 # Returned hash format:
460 # ( "<pak name>" => (
461 # "Installed" => "Yes" or "No" wether the pak is installed,
462 # "ProgVersion" => Installed program version when "Installed" => "Yes" or
463 # Available version when "Installed" => No,
464 # "Release" => Installed pak release number when "Installed" => "Yes" or
465 # Available pak release number when "Installed" => No,
466 # "AvailableProgVersion" => Available program version.
467 # Only defined if an upgrade to a higher version is available,
468 # "AvailableRelease" => Available pak release version.
469 # Only defined if an upgrade to a higher version is available
481 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
485 if ( " $filter " ne "notinstalled" ) {
486 opendir ( DIR
, " $Conf ::dbdir/installed" );
487 my @files = readdir ( DIR
);
490 foreach $file ( @files ) {
491 next if ( $file eq "." );
492 next if ( $file eq ".." );
493 next if ( $file =~ /^old/ );
494 %metadata = parsemetafile
( " $Conf ::dbdir/installed/ $file " );
496 foreach $line ( @db ) {
497 next unless ( $line =~ /.*;.*;.*;/ );
498 @templine = split ( /\;/ , $line );
499 if (( " $metadata {'Name'}" eq " $templine [0]" ) && ( " $metadata {'Release'}" < " $templine [2]" )) {
500 # Add all upgradable paks to list
501 $paklist { " $metadata {'Name'}" } = {
502 ProgVersion
=> $metadata { 'ProgVersion' },
503 Release
=> $metadata { 'Release' },
504 AvailableProgVersion
=> $templine [ 1 ],
505 AvailableRelease
=> $templine [ 2 ],
509 } elsif (( " $metadata {'Name'}" eq " $templine [0]" ) && ( " $filter " ne "upgrade" )) {
510 # Add installed paks without an upgrade available to list
511 $paklist { " $metadata {'Name'}" } = {
512 ProgVersion
=> $metadata { 'ProgVersion' },
513 Release
=> $metadata { 'Release' },
522 # Add all not installed paks to list
523 if (( " $filter " ne "upgrade" ) && ( " $filter " ne "installed" )) {
524 foreach $line ( @db ) {
525 next unless ( $line =~ /.*;.*;.*;/ );
526 @templine = split ( /\;/ , $line );
527 next if (( defined $paklist { " $templine [0]" }) || (& isinstalled
( $templine [ 0 ]) == 0 ));
529 $paklist { " $templine [0]" } = {
530 ProgVersion
=> " $templine [1]" ,
531 Release
=> " $templine [2]" ,
540 sub resolvedeps_one
{
543 message
( "PAKFIRE RESV: $pak : Resolving dependencies..." );
545 unless ( getmetafile
( " $pak " )) {
546 message
( "PAKFIRE ERROR: Error retrieving dependency information on $pak . Unable to resolve dependencies." );
550 my %metadata = parsemetafile
( " $Conf ::dbdir/meta/meta- $pak " );
552 my @deps = split ( / / , $metadata { 'Dependencies' });
556 my $return = & isinstalled
( $_ );
558 message
( "PAKFIRE RESV: $pak : Dependency is already installed: $_ " );
560 message
( "PAKFIRE RESV: $pak : Need to install dependency: $_ " );
573 # Resolve all not yet installed dependencies of $pak
574 my @deps = & resolvedeps_one
( $pak );
577 # For each dependency, we check if more dependencies exist
579 my $dep = pop ( @deps );
581 my @subdeps = & resolvedeps_one
( $dep );
582 foreach my $subdep ( @subdeps ) {
583 # Skip the package we are currently resolving for
584 next if ( $pak eq $subdep );
586 # If the package is not already to be installed,
587 # we add it to the list (@all) and check if it has
588 # more dependencies on its own.
589 unless ( grep { $_ eq $subdep } @all ) {
590 push ( @deps , $subdep );
599 sub resolvedeps_recursive
{
603 foreach my $pkg ( @packages ) {
604 my @deps = & Pakfire
:: resolvedeps
( $pkg );
606 foreach my $dep ( @deps ) {
611 # Sort the result array and remove dupes
612 my %sort = map { $_ , 1 } @result ;
613 @result = keys %sort ;
622 logger
( "CLEANUP: $dir " );
624 if ( " $dir " eq "meta" ) {
625 $path = " $Conf ::dbdir/meta" ;
626 } elsif ( " $dir " eq "tmp" ) {
627 $path = " $Conf ::tmpdir" ;
631 my @files = readdir ( DIR
);
634 unless (( $_ eq "." ) || ( $_ eq ".." )) {
643 # Try to download meta-file if we don't have one yet, or it is empty for some reason
644 if ((! - e
" $Conf ::dbdir/meta/meta- $pak " ) || ( - z
" $Conf ::dbdir/meta/meta- $pak " )) {
645 return 0 unless ( fetchfile
( "meta/meta- $pak " , "" ));
646 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
649 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
653 open ( FILE
, "> $Conf ::dbdir/meta/meta- $pak " );
656 $string =~ s/\r\n/\n/g ;
669 if ( my %metadata = parsemetafile
( " $Conf ::dbdir/meta/meta- $pak " )) {
670 return $metadata { 'Size' };
676 ### This subroutine returns a hash with the contents of a meta- file
677 # Pass path to metafile as argument: Pakfire::parsemetafile("$Conf::dbdir/meta/meta-$pak")
678 # Usage is always with an argument.
679 my $metafile = shift ;
686 if (! - e
$metafile ) {
690 open ( FILE
, "< $metafile " );
695 @templine = split ( /\: / , $_ );
698 $metadata { " $templine [0]" } = $templine [ 1 ];
706 ### This subroutine returns a hash of available info for a package
707 # Pass package name and type of info as argument: Pakfire::getmetadata(package, type_of_info)
708 # Type_of_info can be "latest" or "installed"
709 # Usage is always with two argument.
710 my ( $pak , $type ) = @_ ;
716 my %installed_metadata = ();
721 ### Get available version information
722 if ( " $type " eq "latest" ) {
723 ### Check if package is in packages_list and get latest available version
724 my %db = Pakfire
:: dblist
( "all" );
726 if ( defined $db { $pak }) {
727 ### Get and parse latest available metadata
728 if ( getmetafile
( " $pak " )) {
729 %metadata = parsemetafile
( " $Conf ::dbdir/meta/meta- $pak " );
731 $metadata { 'Available' } = "yes" ;
732 ### Rename version info fields
733 $metadata { 'AvailableProgVersion' } = delete $metadata { 'ProgVersion' };
734 $metadata { 'AvailableRelease' } = delete $metadata { 'Release' };
739 ### Parse installed pak metadata
740 if (& isinstalled
( $pak ) == 0 ) {
741 %installed_metadata = parsemetafile
( " $Conf ::dbdir/installed/meta- $pak " );
743 if ( " $type " eq "latest" && exists ( $metadata { 'AvailableProgVersion' })) {
744 ### Add installed version info to latest metadata
745 $metadata { 'ProgVersion' } = $installed_metadata { 'ProgVersion' };
746 $metadata { 'Release' } = $installed_metadata { 'Release' };
748 ### Use metadata of installed pak
749 %metadata = %installed_metadata ;
751 $metadata { 'Installed' } = 'yes' ;
753 $metadata { 'Installed' } = 'no' ;
764 my $file = getpak
( " $pak " , "noforce" );
766 logger
( "DECRYPT STARTED: $pak " );
767 my $return = system ( "cd $Conf ::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf ::cachedir/ $file 2>/dev/null | tar x" );
769 logger
( "DECRYPT FINISHED: $pak - Status: $return " );
770 if ( $return != 0 ) { exit 1 ; }
777 unless ( getmetafile
( " $pak " )) {
778 message
( "PAKFIRE ERROR: Unable to retrieve $pak metadata." );
782 my %metadata = parsemetafile
( " $Conf ::dbdir/meta/meta- $pak " );
783 my $file = $metadata { 'File' };
786 message
( "No filename given in meta-file." );
790 unless ( " $force " eq "force" ) {
791 if ( - e
" $Conf ::cachedir/ $file " ) {
796 unless ( fetchfile
( "paks/ $file " , "" )) {
797 message
( "PAKFIRE ERROR: Unable to download $pak ." );
806 message
( "PAKFIRE INST: $pak : Decrypting..." );
809 message
( "PAKFIRE INST: $pak : Copying files and running post-installation scripts..." );
810 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./install.sh >> $Conf ::logdir/install- $pak .log 2>&1" );
813 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
815 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
816 message
( "PAKFIRE INST: $pak : Finished." );
819 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
826 # Safety check for lazy testers:
827 # Before we upgrade to the latest release, we re-install the previous release
828 # to make sure that the tester has always been on the latest version.
829 my $tree = & get_tree
();
830 $Conf :: core_mine
-- if ( $tree eq "testing" || $tree eq "unstable" );
832 message
( "CORE UPGR: Upgrading from release $Conf ::core_mine to $core_release " );
834 my @seq = ( $Conf :: core_mine
.. $core_release );
837 foreach $release ( @seq ) {
839 getpak
( "core-upgrade- $release " );
842 foreach $release ( @seq ) {
844 upgradepak
( "core-upgrade- $release " );
847 system ( "echo $core_release > $Conf ::coredir/mine" );
852 if ( open ( FILE
, "< $Conf ::dbdir/installed/meta- $pak " ) ) {
863 message
( "PAKFIRE UPGR: $pak : Decrypting..." );
866 message
( "PAKFIRE UPGR: $pak : Upgrading files and running post-upgrading scripts..." );
867 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./update.sh >> $Conf ::logdir/update- $pak .log 2>&1" );
870 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
872 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
873 message
( "PAKFIRE UPGR: $pak : Finished." );
876 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
885 message
( "PAKFIRE REMV: $pak : Decrypting..." );
888 message
( "PAKFIRE REMV: $pak : Removing files and running post-removing scripts..." );
889 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./uninstall.sh >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
892 unlink ( " $Conf ::dbdir/rootfiles/ $pak " );
893 unlink ( " $Conf ::dbdir/installed/meta- $pak " );
895 message
( "PAKFIRE REMV: $pak : Finished." );
898 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
906 #$size = $size / 1024;
909 if ( $size > 1023 * 1024 ) {
910 $size = ( $size / ( 1024 * 1024 ));
912 } elsif ( $size > 1023 ) {
913 $size = ( $size / 1024 );
918 $size = sprintf ( "%.2f" , $size );
919 my $string = " $size $unit " ;
924 unless ( - e
" $Conf ::dbdir/uuid" ) {
925 open ( FILE
, "</proc/sys/kernel/random/uuid" );
929 open ( FILE
, "> $Conf ::dbdir/uuid" );
938 my ( $data , $response , $protocol ) = @_ ;
939 $final_data .= $data ;
940 print progress_bar
( length ( $final_data ), $total_size , 30 , '=' );
944 my ( $got , $total , $width , $char ) = @_ ;
946 $width ||= 30 ; $char ||= '=' ;
947 my $len_bfile = length $bfile ;
948 if ( " $len_bfile " >= "17" ) {
949 $show_bfile = substr ( $bfile , 0 , 17 ). "..." ;
951 $show_bfile = $bfile ;
953 $progress = sprintf ( "%.2f%%" , 100 * $got /+ $total );
954 sprintf " $color {'lightgreen'}%-20s %7s |%-${width}s| %10s $color {'normal'} \r " , $show_bfile , $progress , $char x
(( $width - 1 )* $got / $total ). '>' , beautifysize
( $got );
957 sub updates_available
{
958 # Get packets with updates available
959 my %upgradepaks = & Pakfire
:: dblist
( "upgrade" );
961 # Get the length of the returned hash
962 my $updatecount = keys %upgradepaks ;
964 return " $updatecount " ;
967 sub reboot_required
{
968 if ( - e
"/var/run/need_reboot" ) {
977 ### This subroutine returns pakfire status information in a hash.
978 # Usage is without arguments
980 # Add core version info
981 my %status = & Pakfire
:: coredbinfo
();
983 # Add last update info
984 $status { 'LastUpdate' } = & General
:: age
( "/opt/pakfire/db/core/mine" );
985 $status { 'LastCoreListUpdate' } = & General
:: age
( "/opt/pakfire/db/lists/core-list.db" );
986 $status { 'LastServerListUpdate' } = & General
:: age
( "/opt/pakfire/db/lists/server-list.db" );
987 $status { 'LastPakListUpdate' } = & General
:: age
( "/opt/pakfire/db/lists/packages_list.db" );
989 # Add number of available package updates
990 $status { 'CoreUpdateAvailable' } = ( defined $status { 'AvailableRelease' }) ?
"yes" : "no" ;
991 $status { 'PakUpdatesAvailable' } = & Pakfire
:: updates_available
();
993 # Add if reboot is required
994 $status { 'RebootRequired' } = & Pakfire
:: reboot_required
();
1000 # Append architecture
1001 my ( $sysname , $nodename , $release , $version , $machine ) = POSIX
:: uname
();
1007 # Return stable if nothing is set
1008 return "stable" unless ( defined $pakfiresettings { 'TREE' });
1010 return $pakfiresettings { 'TREE' };
1013 sub make_version
() {
1016 # Open /etc/system-release
1017 open ( RELEASE
, "</etc/system-release" );
1018 my $release = < RELEASE
>;
1021 # Add the main relase
1022 if ( $release =~ m/IPFire ([\d\.]+)/ ) {
1026 # Append suffix for tree
1027 my $tree = & get_tree
();
1028 if ( $tree eq "testing" ) {
1030 } elsif ( $tree eq "unstable" ) {
1034 # Append architecture
1035 $version .= "-" . & get_arch
();