]>
git.ipfire.org Git - people/pmueller/ipfire-2.x.git/blob - src/pakfire/lib/functions.pl
2 ###############################################################################
4 # IPFire.org - A linux based firewall #
5 # Copyright (C) 2007-2015 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> - Outputs a short list with all available paks." );
118 & Pakfire
:: message
( " <status> - Outputs a summary about available core upgrades, updates and a required reboot" );
119 & Pakfire
:: message
( "" );
120 & Pakfire
:: message
( " Global options:" );
121 & Pakfire
:: message
( " --non-interactive --> Enables the non-interactive mode." );
122 & Pakfire
:: message
( " You won't see any question here." );
123 & Pakfire
:: message
( " -y --> Short for --non-interactive." );
124 & Pakfire
:: message
( " --no-colors --> Turns off the wonderful colors." );
125 & Pakfire
:: message
( "" );
132 my ( @server , $host , $proto , $file , $i );
136 $bfile = basename
( " $getfile " );
138 logger
( "DOWNLOAD STARTED: $getfile " );
141 while (( $allok == 0 ) && $i < 5 ) {
144 if ( " $gethost " eq "" ) {
145 @server = selectmirror
();
148 $file = " $server [2]/ $getfile " ;
154 $proto = "HTTPS" unless $proto ;
156 logger
( "DOWNLOAD INFO: Host: $host ( $proto ) - File: $file " );
158 my $ua = LWP
:: UserAgent
-> new ;
159 $ua -> agent ( "Pakfire/ $Conf ::version" );
162 my %proxysettings =();
163 & General
:: readhash
( "${General::swroot}/proxy/advanced/settings" , \
%proxysettings );
165 if ( $proxysettings { 'UPSTREAM_PROXY' }) {
166 logger
( "DOWNLOAD INFO: Upstream proxy: \" $proxysettings {'UPSTREAM_PROXY'} \" " );
167 if ( $proxysettings { 'UPSTREAM_USER' }) {
168 $ua -> proxy ([ "http" , "https" ], "http:// $proxysettings {'UPSTREAM_USER'}: $proxysettings {'UPSTREAM_PASSWORD'}@" . " $proxysettings {'UPSTREAM_PROXY'}/" );
169 logger
( "DOWNLOAD INFO: Logging in with \" $proxysettings {'UPSTREAM_USER'} \" against \" $proxysettings {'UPSTREAM_PROXY'} \" " );
171 $ua -> proxy ([ "http" , "https" ], "http:// $proxysettings {'UPSTREAM_PROXY'}/" );
179 case
"HTTP" { $url = "http:// $host / $file " ; }
180 case
"HTTPS" { $url = "https:// $host / $file " ; }
182 # skip all lines with unknown protocols
183 logger
( "DOWNLOAD WARNING: Skipping Host: $host due to unknown protocol ( $proto ) in mirror database" );
188 my $result = $ua -> head ( $url );
189 my $remote_headers = $result -> headers ;
190 $total_size = $remote_headers -> content_length ;
191 logger
( "DOWNLOAD INFO: $file has size of $total_size bytes" );
193 my $response = $ua -> get ( $url , ':content_cb' => \
& callback
);
196 my $code = $response -> code ();
197 my $log = $response -> status_line ;
198 logger
( "DOWNLOAD INFO: HTTP-Status-Code: $code - $log " );
200 if ( $code eq "500" ) {
201 message
( "Giving up: There was no chance to get the file \" $getfile \" from any available server. \n There was an error on the way. Please fix it." );
205 if ( $response -> is_success ) {
206 if ( open ( FILE
, "> $Conf ::tmpdir/ $bfile " )) {
207 print FILE
$final_data ;
209 logger
( "DOWNLOAD INFO: File received. Start checking signature..." );
210 if (& valid_signature
( " $Conf ::tmpdir/ $bfile " )) {
211 logger
( "DOWNLOAD INFO: Signature of $bfile is fine." );
212 move
( " $Conf ::tmpdir/ $bfile " , " $Conf ::cachedir/ $bfile " );
214 message
( "DOWNLOAD ERROR: The downloaded file ( $file ) wasn't verified by IPFire.org. Sorry - Exiting..." );
215 my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1` ;
216 if ( $ntp !~ /time\ server(.*)offset(.*)/ ){ message
( "TIME ERROR: Unable to get the nettime, this may lead to the verification error." );}
217 else { $ntp =~ /time\ server(.*)offset(.*)/ ; message
( "TIME INFO: Time Server $1has $2 offset to localtime." );}
220 logger
( "DOWNLOAD FINISHED: $file " );
224 logger
( "DOWNLOAD ERROR: Could not open $Conf ::tmpdir/ $bfile for writing." );
227 logger
( "DOWNLOAD ERROR: $log " );
230 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." );
240 if ( - e
" $Conf ::dbdir/lists/server-list.db" ) {
241 my @stat = stat ( " $Conf ::dbdir/lists/server-list.db" );
243 $age = $time - $stat [ 9 ];
244 $force = "force" if ( " $age " >= "3600" );
245 logger
( "MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force " );
251 if ( " $force " eq "force" ) {
252 fetchfile
( " $Conf ::version/lists/server-list.db" , " $Conf ::mainserver" );
253 move
( " $Conf ::cachedir/server-list.db" , " $Conf ::dbdir/lists/server-list.db" );
263 if ( - e
" $Conf ::dbdir/lists/core-list.db" ) {
264 my @stat = stat ( " $Conf ::dbdir/lists/core-list.db" );
266 $age = $time - $stat [ 9 ];
267 $force = "force" if ( " $age " >= "3600" );
268 logger
( "CORE INFO: core-list.db is $age seconds old. - DEBUG: $force " );
274 if ( " $force " eq "force" ) {
275 fetchfile
( "lists/core-list.db" , "" );
276 move
( " $Conf ::cachedir/core-list.db" , " $Conf ::dbdir/lists/core-list.db" );
280 sub valid_signature
($) {
281 my $filename = shift ;
283 open ( my $cmd , "gpg --verify --status-fd 1 \" $filename \" 2>/dev/null |" );
285 # Process valid signature lines
286 if ( /VALIDSIG ([A-Z0-9]+)/ ) {
287 # Check if we know the key
288 foreach my $key ( @VALID_KEY_FINGERPRINTS ) {
290 return 1 if ( $key eq $1 );
296 # Signature is invalid
301 if ( defined ${ Conf
:: mirror
}) {
302 my $uri = URI
-> new ( "${Conf::mirror}" );
304 # Only accept HTTPS mirrors
305 if ( $uri -> scheme eq "https" ) {
306 return ( "HTTPS" , $uri -> host , $uri -> path . "/" . ${ Conf
:: version
});
308 message
( "MIRROR ERROR: Unsupported mirror: " . ${ Conf
:: mirror
});
312 ### Check if there is a current server list and read it.
313 # If there is no list try to get one.
315 while (!( open ( FILE
, "< $Conf ::dbdir/lists/server-list.db" )) && ( $count lt 5 )) {
317 getmirrors
( "noforce" );
320 message
( "MIRROR ERROR: Could not find or download a server list" );
326 ### Count the number of the servers in the list
330 if ( " $_ " =~ /.*;.*;.*;/ ) {
335 logger
( "MIRROR INFO: $scount servers found in list" );
338 logger
( "MIRROR INFO: Could not find any servers. Falling back to main server $Conf ::mainserver" );
339 return ( "HTTPS" , $Conf :: mainserver
, "/ $Conf ::version" );
342 ### Choose a random server and test if it is online
343 # If the check fails try a new server.
344 # This will never give up.
347 $server = int ( rand ( $scount ) + 1 );
349 my ( $line , $proto , $path , $host );
351 foreach $line ( @newlines ) {
353 if ( $servers eq $server ) {
354 @templine = split ( /\;/ , $line );
355 $proto = $templine [ 0 ];
356 $host = $templine [ 1 ];
357 $path = $templine [ 2 ];
359 return ( $proto , $host , $path );
366 ### Update the database if the file is older than one day.
367 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
368 # Usage is always with an argument.
374 if ( - e
" $Conf ::dbdir/lists/packages_list.db" ) {
375 my @stat = stat ( " $Conf ::dbdir/lists/packages_list.db" );
377 $age = $time - $stat [ 9 ];
378 $force = "force" if ( " $age " >= "3600" );
379 logger
( "DB INFO: packages_list.db is $age seconds old. - DEBUG: $force " );
385 if ( " $force " eq "force" ) {
386 fetchfile
( "lists/packages_list.db" , "" );
387 move
( " $Conf ::cachedir/packages_list.db" , " $Conf ::dbdir/lists/packages_list.db" );
390 # Update the meta database if new packages was in the package list
395 my ( $name , $version , $release );
398 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
402 opendir ( DIR
, " $Conf ::dbdir/meta" );
403 my @files = readdir ( DIR
);
405 foreach $file ( @files ) {
406 next if ( $file eq "." );
407 next if ( $file eq ".." );
408 next if ( $file eq "meta-" );
409 next if ( $file =~ /^old/ );
410 open ( FILE
, "< $Conf ::dbdir/meta/ $file " );
413 foreach $line ( @meta ) {
414 @templine = split ( /\: / , $line );
415 if ( " $templine [0]" eq "Name" ) {
416 $name = $templine [ 1 ];
418 } elsif ( " $templine [0]" eq "ProgVersion" ) {
419 $version = $templine [ 1 ];
421 } elsif ( " $templine [0]" eq "Release" ) {
422 $release = $templine [ 1 ];
426 foreach $prog ( @db ) {
427 @templine = split ( /\;/ , $prog );
428 if (( " $name " eq " $templine [0]" ) && ( " $release " ne " $templine [2]" )) {
429 move
( " $Conf ::dbdir/meta/meta- $name " , " $Conf ::dbdir/meta/old_meta- $name " );
430 fetchfile
( "meta/meta- $name " , "" );
431 move
( " $Conf ::cachedir/meta- $name " , " $Conf ::dbdir/meta/meta- $name " );
438 ### This subroutine lists the packages.
439 # You may also pass a filter: &Pakfire::dblist(filter)
440 # Usage is always with two arguments.
441 # filter may be: all, notinstalled, installed
449 my ( $name , $version , $release );
452 ### Make sure that the list is not outdated.
453 #dbgetlist("noforce");
455 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
459 if ( " $filter " eq "upgrade" ) {
460 if ( " $forweb " ne "forweb" && " $forweb " ne "notice" ) { getcoredb
( "noforce" );}
461 eval ( `grep "core_" $Conf ::dbdir/lists/core-list.db` );
462 if ( " $core_release " > " $Conf ::core_mine" ) {
463 if ( " $forweb " eq "forweb" ) {
464 print "<option value= \" core \" >Core-Update -- $Conf ::version -- Release: $Conf ::core_mine -> $core_release </option> \n " ;
466 elsif ( " $forweb " eq "notice" ) {
467 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>" ;
469 my $command = "Core-Update $Conf ::version \n Release: $Conf ::core_mine -> $core_release \n " ;
470 if ( " $Pakfire ::enable_colors" eq "1" ) {
471 print " $color {'lila'} $command $color {'normal'} \n " ;
478 opendir ( DIR
, " $Conf ::dbdir/installed" );
479 my @files = readdir ( DIR
);
481 foreach $file ( @files ) {
482 next if ( $file eq "." );
483 next if ( $file eq ".." );
484 next if ( $file =~ /^old/ );
485 open ( FILE
, "< $Conf ::dbdir/installed/ $file " );
488 foreach $line ( @meta ) {
489 @templine = split ( /\: / , $line );
490 if ( " $templine [0]" eq "Name" ) {
491 $name = $templine [ 1 ];
493 } elsif ( " $templine [0]" eq "ProgVersion" ) {
494 $version = $templine [ 1 ];
496 } elsif ( " $templine [0]" eq "Release" ) {
497 $release = $templine [ 1 ];
501 foreach $prog ( @db ) {
502 @templine = split ( /\;/ , $prog );
503 if (( " $name " eq " $templine [0]" ) && ( " $release " < " $templine [2]" && " $forweb " ne "notice" )) {
504 push ( @updatepaks , $name );
505 if ( " $forweb " eq "forweb" ) {
506 print "<option value= \" $name \" >Update: $name -- Version: $version -> $templine [1] -- Release: $release -> $templine [2]</option> \n " ;
508 my $command = "Update: $name \n Version: $version -> $templine [1] \n Release: $release -> $templine [2] \n " ;
509 if ( " $Pakfire ::enable_colors" eq "1" ) {
510 print " $color {'lila'} $command $color {'normal'} \n " ;
524 foreach $line ( sort @db ) {
525 next unless ( $line =~ /.*;.*;.*;/ );
527 @templine = split ( /\;/ , $line );
528 if ( " $filter " eq "notinstalled" ) {
529 next if ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
530 } elsif ( " $filter " eq "installed" ) {
531 next unless ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
534 if ( " $forweb " eq "forweb" )
536 if ( " $filter " eq "notinstalled" ) {
537 print "<option value= \" $templine [0] \" > $templine [0]- $templine [1]- $templine [2]</option> \n " ;
539 print "<option value= \" $templine [0] \" > $templine [0]</option> \n " ;
542 if ( " $Pakfire ::enable_colors" eq "1" ) {
543 if (& isinstalled
( " $templine [0]" )) {
544 $use_color = " $color {'red'}"
546 $use_color = " $color {'green'}"
549 print "${use_color}Name: $templine [0] \n ProgVersion: $templine [1] \n Release: $templine [2] $color {'normal'} \n\n " ;
552 print " $count packages total. \n " unless ( " $forweb " eq "forweb" );
556 sub resolvedeps_one
{
561 message
( "PAKFIRE RESV: $pak : Resolving dependencies..." );
563 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
568 my ( @templine , @deps , @all );
569 foreach $line ( @file ) {
570 @templine = split ( /\: / , $line );
571 if ( " $templine [0]" eq "Dependencies" ) {
572 @deps = split ( / / , $templine [ 1 ]);
578 my $return = & isinstalled
( $_ );
580 message
( "PAKFIRE RESV: $pak : Dependency is already installed: $_ " );
582 message
( "PAKFIRE RESV: $pak : Need to install dependency: $_ " );
595 # Resolve all not yet installed dependencies of $pak
596 my @deps = & resolvedeps_one
( $pak );
599 # For each dependency, we check if more dependencies exist
601 my $dep = pop ( @deps );
603 my @subdeps = & resolvedeps_one
( $dep );
604 foreach my $subdep ( @subdeps ) {
605 # Skip the package we are currently resolving for
606 next if ( $pak eq $subdep );
608 # If the package is not already to be installed,
609 # we add it to the list (@all) and check if it has
610 # more dependencies on its own.
611 unless ( grep { $_ eq $subdep } @all ) {
612 push ( @deps , $subdep );
621 sub resolvedeps_recursive
{
625 foreach my $pkg ( @packages ) {
626 my @deps = & Pakfire
:: resolvedeps
( $pkg );
628 foreach my $dep ( @deps ) {
633 # Sort the result array and remove dupes
634 my %sort = map { $_ , 1 } @result ;
635 @result = keys %sort ;
644 logger
( "CLEANUP: $dir " );
646 if ( " $dir " eq "meta" ) {
647 $path = " $Conf ::dbdir/meta" ;
648 } elsif ( " $dir " eq "tmp" ) {
649 $path = " $Conf ::tmpdir" ;
653 my @files = readdir ( DIR
);
656 unless (( $_ eq "." ) || ( $_ eq ".." )) {
665 unless ( - e
" $Conf ::dbdir/meta/meta- $pak " ) {
666 fetchfile
( "meta/meta- $pak " , "" );
667 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
670 if ( - z
" $Conf ::dbdir/meta/meta- $pak " ) {
671 fetchfile
( "meta/meta- $pak " , "" );
672 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
675 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
679 open ( FILE
, "> $Conf ::dbdir/meta/meta- $pak " );
682 $string =~ s/\r\n/\n/g ;
694 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
700 foreach $line ( @file ) {
701 @templine = split ( /\: / , $line );
702 if ( " $templine [0]" eq "Size" ) {
715 my $file = getpak
( " $pak " , "noforce" );
717 logger
( "DECRYPT STARTED: $pak " );
718 my $return = system ( "cd $Conf ::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf ::cachedir/ $file 2>/dev/null | tar x" );
720 logger
( "DECRYPT FINISHED: $pak - Status: $return " );
721 if ( $return != 0 ) { exit 1 ; }
730 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
737 foreach $line ( @file ) {
738 @templine = split ( /\: / , $line );
739 if ( " $templine [0]" eq "File" ) {
741 $file = $templine [ 1 ];
746 message
( "No filename given in meta-file." );
750 unless ( " $force " eq "force" ) {
751 if ( - e
" $Conf ::cachedir/ $file " ) {
756 fetchfile
( "paks/ $file " , "" );
763 message
( "PAKFIRE INST: $pak : Decrypting..." );
766 message
( "PAKFIRE INST: $pak : Copying files and running post-installation scripts..." );
767 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./install.sh >> $Conf ::logdir/install- $pak .log 2>&1" );
770 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
772 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
773 message
( "PAKFIRE INST: $pak : Finished." );
776 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
783 getcoredb
( "noforce" );
784 eval ( `grep "core_" $Conf ::dbdir/lists/core-list.db` );
785 if ( " $core_release " > " $Conf ::core_mine" ) {
786 # Safety check for lazy testers:
787 # Before we upgrade to the latest release, we re-install the previous release
788 # to make sure that the tester has always been on the latest version.
789 my $tree = & get_tree
();
790 $Conf :: core_mine
-- if ( $tree eq "testing" || $tree eq "unstable" );
792 message
( "CORE UPGR: Upgrading from release $Conf ::core_mine to $core_release " );
794 my @seq = `seq $Conf ::core_mine $core_release ` ;
797 foreach $release ( @seq ) {
799 getpak
( "core-upgrade- $release " );
802 foreach $release ( @seq ) {
804 upgradepak
( "core-upgrade- $release " );
807 system ( "echo $core_release > $Conf ::coredir/mine" );
810 message
( "CORE ERROR: No new upgrades available. You are on release $Conf ::core_mine." );
816 if ( open ( FILE
, "< $Conf ::dbdir/installed/meta- $pak " ) ) {
827 message
( "PAKFIRE UPGR: $pak : Decrypting..." );
830 message
( "PAKFIRE UPGR: $pak : Upgrading files and running post-upgrading scripts..." );
831 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./update.sh >> $Conf ::logdir/update- $pak .log 2>&1" );
834 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
836 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
837 message
( "PAKFIRE UPGR: $pak : Finished." );
840 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
849 message
( "PAKFIRE REMV: $pak : Decrypting..." );
852 message
( "PAKFIRE REMV: $pak : Removing files and running post-removing scripts..." );
853 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./uninstall.sh >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
856 unlink ( " $Conf ::dbdir/rootfiles/ $pak " );
857 unlink ( " $Conf ::dbdir/installed/meta- $pak " );
859 message
( "PAKFIRE REMV: $pak : Finished." );
862 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
870 #$size = $size / 1024;
873 if ( $size > 1023 * 1024 ) {
874 $size = ( $size / ( 1024 * 1024 ));
876 } elsif ( $size > 1023 ) {
877 $size = ( $size / 1024 );
882 $size = sprintf ( "%.2f" , $size );
883 my $string = " $size $unit " ;
888 unless ( - e
" $Conf ::dbdir/uuid" ) {
889 open ( FILE
, "</proc/sys/kernel/random/uuid" );
893 open ( FILE
, "> $Conf ::dbdir/uuid" );
902 my ( $data , $response , $protocol ) = @_ ;
903 $final_data .= $data ;
904 print progress_bar
( length ( $final_data ), $total_size , 30 , '=' );
908 my ( $got , $total , $width , $char ) = @_ ;
910 $width ||= 30 ; $char ||= '=' ;
911 my $len_bfile = length $bfile ;
912 if ( " $len_bfile " >= "17" ) {
913 $show_bfile = substr ( $bfile , 0 , 17 ). "..." ;
915 $show_bfile = $bfile ;
917 $progress = sprintf ( "%.2f%%" , 100 * $got /+ $total );
918 sprintf " $color {'lightgreen'}%-20s %7s |%-${width}s| %10s $color {'normal'} \r " , $show_bfile , $progress , $char x
(( $width - 1 )* $got / $total ). '>' , beautifysize
( $got );
921 sub updates_available
{
922 # Get packets with updates available
923 my @upgradepaks = & Pakfire
:: dblist
( "upgrade" , "noweb" );
925 # Get the length of the returned array
926 my $updatecount = scalar @upgradepaks ;
928 return " $updatecount " ;
931 sub coreupdate_available
{
932 eval ( `grep "core_" $Conf ::dbdir/lists/core-list.db` );
933 if ( " $core_release " > " $Conf ::core_mine" ) {
934 return "yes ( $core_release )" ;
941 sub reboot_required
{
942 if ( - e
"/var/run/need_reboot" ) {
952 my $return = "Core-Version: $Conf ::version \n " ;
953 $return .= "Core-Update-Level: $Conf ::core_mine \n " ;
954 $return .= "Last update: " . & General
:: age
( "/opt/pakfire/db/core/mine" ) . " ago \n " ;
955 $return .= "Last core-list update: " . & General
:: age
( "/opt/pakfire/db/lists/core-list.db" ) . " ago \n " ;
956 $return .= "Last server-list update: " . & General
:: age
( "/opt/pakfire/db/lists/server-list.db" ) . " ago \n " ;
957 $return .= "Last packages-list update: " . & General
:: age
( "/opt/pakfire/db/lists/packages_list.db" ) . " ago \n " ;
959 # Get availability of core updates
960 $return .= "Core-Update available: " . & Pakfire
:: coreupdate_available
() . " \n " ;
962 # Get availability of package updates
963 $return .= "Package-Updates available: " . & Pakfire
:: updates_available
() . " \n " ;
965 # Test if reboot is required
966 $return .= "Reboot required: " . & Pakfire
:: reboot_required
() . " \n " ;
974 # Append architecture
975 my ( $sysname , $nodename , $release , $version , $machine ) = POSIX
:: uname
();
977 # We only support armv6l for 32 bit arm
978 if ( $machine =~ m/armv[67]/ ) {
986 # Return stable if nothing is set
987 return "stable" unless ( defined $pakfiresettings { 'TREE' });
989 return $pakfiresettings { 'TREE' };
995 # Open /etc/system-release
996 open ( RELEASE
, "</etc/system-release" );
997 my $release = < RELEASE
>;
1000 # Add the main relase
1001 if ( $release =~ m/IPFire ([\d\.]+)/ ) {
1005 # Append suffix for tree
1006 my $tree = & get_tree
();
1007 if ( $tree eq "testing" ) {
1009 } elsif ( $tree eq "unstable" ) {
1013 # Append architecture
1014 $version .= "-" . & get_arch
();