]>
git.ipfire.org Git - people/pmueller/ipfire-2.x.git/blob - src/pakfire/lib/functions.pl
85e01a060ab34783e5214f8aff99afbed6099d9e
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" ;
37 my $myid = "64D96617" ; # Our own gpg-key paks@ipfire.org
38 my $trustid = "65D0FD58" ; # gpg-key of CaCert
40 # A small color-hash :D
42 $color { 'normal' } = " \033 [0m" ;
43 $color { 'black' } = " \033 [0;30m" ;
44 $color { 'darkgrey' } = " \033 [1;30m" ;
45 $color { 'blue' } = " \033 [0;34m" ;
46 $color { 'lightblue' } = " \033 [1;34m" ;
47 $color { 'green' } = " \033 [0;32m" ;
48 $color { 'lightgreen' } = " \033 [1;32m" ;
49 $color { 'cyan' } = " \033 [0;36m" ;
50 $color { 'lightcyan' } = " \033 [1;36m" ;
51 $color { 'red' } = " \033 [0;31m" ;
52 $color { 'lightred' } = " \033 [1;31m" ;
53 $color { 'purple' } = " \033 [0;35m" ;
54 $color { 'lightpurple' } = " \033 [1;35m" ;
55 $color { 'brown' } = " \033 [0;33m" ;
56 $color { 'lightgrey' } = " \033 [0;37m" ;
57 $color { 'yellow' } = " \033 [1;33m" ;
58 $color { 'white' } = " \033 [1;37m" ;
59 our $enable_colors = 1 ;
65 my %pakfiresettings = ();
66 & General
:: readhash
( "${General::swroot}/pakfire/settings" , \
%pakfiresettings );
72 if ( $enable_colors == 1 ) {
73 if ( " $message " =~ /ERROR/ ) {
74 $message = " $color {'red'} $message $color {'normal'}" ;
75 } elsif ( " $message " =~ /INFO/ ) {
76 $message = " $color {'cyan'} $message $color {'normal'}" ;
77 } elsif ( " $message " =~ /WARN/ ) {
78 $message = " $color {'yellow'} $message $color {'normal'}" ;
79 } elsif ( " $message " =~ /RESV/ ) {
80 $message = " $color {'purple'} $message $color {'normal'}" ;
81 } elsif ( " $message " =~ /INST/ ) {
82 $message = " $color {'green'} $message $color {'normal'}" ;
83 } elsif ( " $message " =~ /REMV/ ) {
84 $message = " $color {'lightred'} $message $color {'normal'}" ;
85 } elsif ( " $message " =~ /UPGR/ ) {
86 $message = " $color {'lightblue'} $message $color {'normal'}" ;
96 #system("echo \"`date`: $log\" >> /var/log/pakfire.log");
97 system ( "logger -t pakfire \" $log \" " );
102 & Pakfire
:: message
( "Usage: pakfire <install|remove> [options] <pak(s)>" );
103 & Pakfire
:: message
( " <update> - Contacts the servers for new lists of paks." );
104 & Pakfire
:: message
( " <upgrade> - Installs the latest version of all paks." );
105 & Pakfire
:: message
( " <list> - Outputs a short list with all available paks." );
106 & Pakfire
:: message
( "" );
107 & Pakfire
:: message
( " Global options:" );
108 & Pakfire
:: message
( " --non-interactive --> Enables the non-interactive mode." );
109 & Pakfire
:: message
( " You won't see any question here." );
110 & Pakfire
:: message
( " -y --> Short for --non-interactive." );
111 & Pakfire
:: message
( " --no-colors --> Turns off the wonderful colors." );
112 & Pakfire
:: message
( "" );
119 $p = Net
:: Ping
-> new ( "icmp" );
120 if ( $p -> ping ( $host )) {
121 logger
( "PING INFO: $host is alive" );
124 logger
( "PING INFO: $host is unreachable" );
133 my ( @server , $host , $proto , $file , $i );
137 $bfile = basename
( " $getfile " );
139 logger
( "DOWNLOAD STARTED: $getfile " ) unless ( $bfile =~ /^counter\?.*/ );
142 while (( $allok == 0 ) && $i < 5 ) {
145 if ( " $gethost " eq "" ) {
146 @server = selectmirror
();
149 $file = " $server [2]/ $getfile " ;
155 $proto = "HTTP" unless $proto ;
157 unless ( $bfile =~ /^counter\?.*/ ) {
158 logger
( "DOWNLOAD INFO: Host: $host ( $proto ) - File: $file " );
161 my $ua = LWP
:: UserAgent
-> new ;
162 $ua -> agent ( "Pakfire/ $Conf ::version" );
165 my %proxysettings =();
166 & General
:: readhash
( "${General::swroot}/proxy/advanced/settings" , \
%proxysettings );
168 if ( $proxysettings { 'UPSTREAM_PROXY' }) {
169 logger
( "DOWNLOAD INFO: Upstream proxy: \" $proxysettings {'UPSTREAM_PROXY'} \" " ) unless ( $bfile =~ /^counter.py\?.*/ );
170 if ( $proxysettings { 'UPSTREAM_USER' }) {
171 $ua -> proxy ( "http" , "http:// $proxysettings {'UPSTREAM_USER'}: $proxysettings {'UPSTREAM_PASSWORD'}@" . " $proxysettings {'UPSTREAM_PROXY'}/" );
172 logger
( "DOWNLOAD INFO: Logging in with: \" $proxysettings {'UPSTREAM_USER'} \" - \" $proxysettings {'UPSTREAM_PASSWORD'} \" " ) unless ( $bfile =~ /^counter.py\?.*/ );
174 $ua -> proxy ( "http" , "http:// $proxysettings {'UPSTREAM_PROXY'}/" );
179 my $url = "http:// $host / $file " ;
182 unless ( $bfile =~ /^counter.py\?.*/ ) {
183 my $result = $ua -> head ( $url );
184 my $remote_headers = $result -> headers ;
185 $total_size = $remote_headers -> content_length ;
186 logger
( "DOWNLOAD INFO: $file has size of $total_size bytes" );
188 $response = $ua -> get ( $url , ':content_cb' => \
& callback
);
191 $response = $ua -> get ( $url );
194 my $code = $response -> code ();
195 my $log = $response -> status_line ;
196 logger
( "DOWNLOAD INFO: HTTP-Status-Code: $code - $log " );
198 if ( $code eq "500" ) {
199 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." );
203 if ( $response -> is_success ) {
204 unless ( $bfile =~ /^counter.py\?.*/ ) {
205 if ( open ( FILE
, "> $Conf ::tmpdir/ $bfile " )) {
206 print FILE
$final_data ;
208 logger
( "DOWNLOAD INFO: File received. Start checking signature..." );
209 if ( system ( "gpg --verify \" $Conf ::tmpdir/ $bfile \" &>/dev/null" ) eq 0 ) {
210 logger
( "DOWNLOAD INFO: Signature of $bfile is fine." );
211 move
( " $Conf ::tmpdir/ $bfile " , " $Conf ::cachedir/ $bfile " );
213 message
( "DOWNLOAD ERROR: The downloaded file ( $file ) wasn't verified by IPFire.org. Sorry - Exiting..." );
214 my $ntp = `ntpdate -q -t 10 pool.ntp.org 2>/dev/null | tail -1` ;
215 if ( $ntp !~ /time\ server(.*)offset(.*)/ ){ message
( "TIME ERROR: Unable to get the nettime, this may lead to the verification error." );}
216 else { $ntp =~ /time\ server(.*)offset(.*)/ ; message
( "TIME INFO: Time Server $1has $2 offset to localtime." );}
219 logger
( "DOWNLOAD FINISHED: $file " );
223 logger
( "DOWNLOAD ERROR: Could not open $Conf ::tmpdir/ $bfile for writing." );
229 logger
( "DOWNLOAD ERROR: $log " );
232 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." );
242 if ( - e
" $Conf ::dbdir/lists/server-list.db" ) {
243 my @stat = stat ( " $Conf ::dbdir/lists/server-list.db" );
245 $age = $time - $stat [ 9 ];
246 $force = "force" if ( " $age " >= "3600" );
247 logger
( "MIRROR INFO: server-list.db is $age seconds old. - DEBUG: $force " );
253 if ( " $force " eq "force" ) {
254 fetchfile
( " $Conf ::version/lists/server-list.db" , " $Conf ::mainserver" );
255 move
( " $Conf ::cachedir/server-list.db" , " $Conf ::dbdir/lists/server-list.db" );
265 if ( - e
" $Conf ::dbdir/lists/core-list.db" ) {
266 my @stat = stat ( " $Conf ::dbdir/lists/core-list.db" );
268 $age = $time - $stat [ 9 ];
269 $force = "force" if ( " $age " >= "3600" );
270 logger
( "CORE INFO: core-list.db is $age seconds old. - DEBUG: $force " );
276 if ( " $force " eq "force" ) {
277 fetchfile
( "lists/core-list.db" , "" );
278 move
( " $Conf ::cachedir/core-list.db" , " $Conf ::dbdir/lists/core-list.db" );
284 ### Check if there is a current server list and read it.
285 # If there is no list try to get one.
287 while (!( open ( FILE
, "< $Conf ::dbdir/lists/server-list.db" )) && ( $count lt 5 )) {
289 getmirrors
( "noforce" );
292 message
( "MIRROR ERROR: Could not find or download a server list" );
298 ### Count the number of the servers in the list
302 if ( " $_ " =~ /.*;.*;.*;/ ) {
307 logger
( "MIRROR INFO: $scount servers found in list" );
310 logger
( "MIRROR INFO: Could not find any servers. Falling back to main server $Conf ::mainserver" );
311 return ( "HTTP" , $Conf :: mainserver
, "/ $Conf ::version" );
314 ### Choose a random server and test if it is online
315 # If the check fails try a new server.
316 # This will never give up.
320 while ( $found == 0 ) {
321 $server = int ( rand ( $scount ) + 1 );
323 my ( $line , $proto , $path , $host );
325 foreach $line ( @newlines ) {
327 if ( $servers eq $server ) {
328 @templine = split ( /\;/ , $line );
329 $proto = $templine [ 0 ];
330 $host = $templine [ 1 ];
331 $path = $templine [ 2 ];
332 if ( $pakfiresettings { 'HEALTHCHECK' } eq "off" ) {
333 logger
( "PING INFO: Healthcheck is disabled" );
335 return ( $proto , $host , $path );
337 elsif ( pinghost
( " $host " )) {
339 return ( $proto , $host , $path );
343 $pingdelay = $pingdelay * 2 ;
344 if ( $pingdelay > 1200 ) {
354 ### Update the database if the file is older than one day.
355 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
356 # Usage is always with an argument.
362 if ( - e
" $Conf ::dbdir/lists/packages_list.db" ) {
363 my @stat = stat ( " $Conf ::dbdir/lists/packages_list.db" );
365 $age = $time - $stat [ 9 ];
366 $force = "force" if ( " $age " >= "3600" );
367 logger
( "DB INFO: packages_list.db is $age seconds old. - DEBUG: $force " );
373 if ( " $force " eq "force" ) {
374 fetchfile
( "lists/packages_list.db" , "" );
375 move
( " $Conf ::cachedir/packages_list.db" , " $Conf ::dbdir/lists/packages_list.db" );
378 # Update the meta database if new packages was in the package list
383 my ( $name , $version , $release );
386 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
390 opendir ( DIR
, " $Conf ::dbdir/meta" );
391 my @files = readdir ( DIR
);
393 foreach $file ( @files ) {
394 next if ( $file eq "." );
395 next if ( $file eq ".." );
396 next if ( $file =~ /^old/ );
397 open ( FILE
, "< $Conf ::dbdir/meta/ $file " );
400 foreach $line ( @meta ) {
401 @templine = split ( /\: / , $line );
402 if ( " $templine [0]" eq "Name" ) {
403 $name = $templine [ 1 ];
405 } elsif ( " $templine [0]" eq "ProgVersion" ) {
406 $version = $templine [ 1 ];
408 } elsif ( " $templine [0]" eq "Release" ) {
409 $release = $templine [ 1 ];
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 " );
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
436 my ( $name , $version , $release );
439 ### Make sure that the list is not outdated.
440 #dbgetlist("noforce");
442 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
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 " ;
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>" ;
456 my $command = "Core-Update $Conf ::version \n Release: $Conf ::core_mine -> $core_release \n " ;
457 if ( " $Pakfire ::enable_colors" eq "1" ) {
458 print " $color {'lila'} $command $color {'normal'} \n " ;
465 opendir ( DIR
, " $Conf ::dbdir/installed" );
466 my @files = readdir ( 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 " );
475 foreach $line ( @meta ) {
476 @templine = split ( /\: / , $line );
477 if ( " $templine [0]" eq "Name" ) {
478 $name = $templine [ 1 ];
480 } elsif ( " $templine [0]" eq "ProgVersion" ) {
481 $version = $templine [ 1 ];
483 } elsif ( " $templine [0]" eq "Release" ) {
484 $release = $templine [ 1 ];
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 " ;
495 my $command = "Update: $name \n Version: $version -> $templine [1] \n Release: $release -> $templine [2] \n " ;
496 if ( " $Pakfire ::enable_colors" eq "1" ) {
497 print " $color {'lila'} $command $color {'normal'} \n " ;
511 foreach $line ( sort @db ) {
512 next unless ( $line =~ /.*;.*;.*;/ );
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]" );
521 if ( " $forweb " eq "forweb" ) {
522 print "<option value= \" $templine [0] \" > $templine [0]- $templine [1]- $templine [2]</option> \n " ;
524 if ( " $Pakfire ::enable_colors" eq "1" ) {
525 if (& isinstalled
( " $templine [0]" )) {
526 $use_color = " $color {'red'}"
528 $use_color = " $color {'green'}"
531 print "${use_color}Name: $templine [0] \n ProgVersion: $templine [1] \n Release: $templine [2] $color {'normal'} \n\n " ;
534 print " $count packages total. \n " unless ( " $forweb " eq "forweb" );
543 message
( "PAKFIRE RESV: $pak : Resolving dependencies..." );
545 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
550 my ( @templine , @deps , @tempdeps , @all );
551 foreach $line ( @file ) {
552 @templine = split ( /\: / , $line );
553 if ( " $templine [0]" eq "Dependencies" ) {
554 @deps = split ( / / , $templine [ 1 ]);
560 my $return = & isinstalled
( $_ );
562 message
( "PAKFIRE RESV: $pak : Dependency is already installed: $_ " );
564 message
( "PAKFIRE RESV: $pak : Need to install dependency: $_ " );
571 foreach ( @tempdeps ) {
573 my @newdeps = resolvedeps
( " $_ " );
575 unless (( $_ eq " " ) || ( $_ eq "" )) {
576 my $return = & isinstalled
( $_ );
578 message
( "PAKFIRE RESV: $pak : Dependency is already installed: $_ " );
580 message
( "PAKFIRE RESV: $pak : Need to install dependency: $_ " );
592 sub resolvedeps_recursive
{
593 my @packages = shift ;
596 foreach my $pkg ( @packages ) {
597 my @deps = & Pakfire
:: resolvedeps
( $pkg );
599 foreach my $dep ( @deps ) {
604 # Sort the result array and remove dupes
605 my %sort = map { $_ , 1 } @result ;
606 @result = keys %sort ;
615 logger
( "CLEANUP: $dir " );
617 if ( " $dir " eq "meta" ) {
618 $path = " $Conf ::dbdir/meta" ;
619 } elsif ( " $dir " eq "tmp" ) {
620 $path = " $Conf ::tmpdir" ;
624 my @files = readdir ( DIR
);
627 unless (( $_ eq "." ) || ( $_ eq ".." )) {
636 unless ( - e
" $Conf ::dbdir/meta/meta- $pak " ) {
637 fetchfile
( "meta/meta- $pak " , "" );
638 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
641 if ( - z
" $Conf ::dbdir/meta/meta- $pak " ) {
642 fetchfile
( "meta/meta- $pak " , "" );
643 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
646 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
650 open ( FILE
, "> $Conf ::dbdir/meta/meta- $pak " );
653 $string =~ s/\r\n/\n/g ;
665 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
671 foreach $line ( @file ) {
672 @templine = split ( /\: / , $line );
673 if ( " $templine [0]" eq "Size" ) {
686 my $file = getpak
( " $pak " , "noforce" );
688 logger
( "DECRYPT STARTED: $pak " );
689 my $return = system ( "cd $Conf ::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf ::cachedir/ $file 2>/dev/null | tar x" );
691 logger
( "DECRYPT FINISHED: $pak - Status: $return " );
692 if ( $return != 0 ) { exit 1 ; }
701 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
708 foreach $line ( @file ) {
709 @templine = split ( /\: / , $line );
710 if ( " $templine [0]" eq "File" ) {
712 $file = $templine [ 1 ];
717 message
( "No filename given in meta-file. Please phone the developers." );
721 unless ( " $force " eq "force" ) {
722 if ( - e
" $Conf ::cachedir/ $file " ) {
727 fetchfile
( "paks/ $file " , "" );
734 message
( "PAKFIRE INST: $pak : Decrypting..." );
737 message
( "PAKFIRE INST: $pak : Copying files and running post-installation scripts..." );
738 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./install.sh >> $Conf ::logdir/install- $pak .log 2>&1" );
740 if ( $pakfiresettings { 'UUID' } ne "off" ) {
741 fetchfile
( "counter.py?ver= $Conf ::version&uuid= $Conf ::uuid&ipak= $pak &return= $return " , " $Conf ::mainserver" );
744 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
746 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
747 message
( "PAKFIRE INST: $pak : Finished." );
750 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
757 getcoredb
( "noforce" );
758 eval ( `grep "core_" $Conf ::dbdir/lists/core-list.db` );
759 if ( " $core_release " > " $Conf ::core_mine" ) {
760 message
( "CORE UPGR: Upgrading from release $Conf ::core_mine to $core_release " );
762 my @seq = `seq $Conf ::core_mine $core_release ` ;
765 foreach $release ( @seq ) {
767 getpak
( "core-upgrade- $release " );
770 foreach $release ( @seq ) {
772 upgradepak
( "core-upgrade- $release " );
775 system ( "echo $core_release > $Conf ::coredir/mine" );
778 message
( "CORE ERROR: No new upgrades available. You are on release $Conf ::core_mine." );
784 if ( open ( FILE
, "< $Conf ::dbdir/installed/meta- $pak " ) ) {
795 message
( "PAKFIRE UPGR: $pak : Decrypting..." );
798 message
( "PAKFIRE UPGR: $pak : Upgrading files and running post-upgrading scripts..." );
799 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./update.sh >> $Conf ::logdir/update- $pak .log 2>&1" );
801 if ( $pakfiresettings { 'UUID' } ne "off" ) {
802 fetchfile
( "counter.py?ver= $Conf ::version&uuid= $Conf ::uuid&upak= $pak &return= $return " , " $Conf ::mainserver" );
805 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
807 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
808 message
( "PAKFIRE UPGR: $pak : Finished." );
811 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
820 message
( "PAKFIRE REMV: $pak : Decrypting..." );
823 message
( "PAKFIRE REMV: $pak : Removing files and running post-removing scripts..." );
824 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./uninstall.sh >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
826 if ( $pakfiresettings { 'UUID' } ne "off" ) {
827 fetchfile
( "counter.py?ver= $Conf ::version&uuid= $Conf ::uuid&dpak= $pak &return= $return " , " $Conf ::mainserver" );
830 unlink ( " $Conf ::dbdir/rootfiles/ $pak " );
831 unlink ( " $Conf ::dbdir/installed/meta- $pak " );
833 message
( "PAKFIRE REMV: $pak : Finished." );
836 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
844 #$size = $size / 1024;
847 if ( $size > 1023 * 1024 ) {
848 $size = ( $size / ( 1024 * 1024 ));
850 } elsif ( $size > 1023 ) {
851 $size = ( $size / 1024 );
856 $size = sprintf ( "%.2f" , $size );
857 my $string = " $size $unit " ;
862 unless ( - e
" $Conf ::dbdir/uuid" ) {
863 open ( FILE
, "</proc/sys/kernel/random/uuid" );
867 open ( FILE
, "> $Conf ::dbdir/uuid" );
876 if ( $pakfiresettings { 'UUID' } ne "off" ) {
877 unless ( " $Conf ::uuid" ) {
878 $Conf :: uuid
= `cat $Conf ::dbdir/uuid` ;
880 logger
( "Sending my uuid: $Conf ::uuid" );
881 fetchfile
( "counter.py?ver= $Conf ::version&uuid= $Conf ::uuid" , " $Conf ::mainserver" );
882 system ( "rm -f $Conf ::tmpdir/counter* 2>/dev/null" );
887 logger
( "CRYPTO INFO: Checking GnuPG Database" );
888 my $ret = system ( "gpg --list-keys | grep -q $myid " );
889 unless ( " $ret " eq "0" ) {
890 message
( "CRYPTO WARN: The GnuPG isn't configured corectly. Trying now to fix this." );
891 message
( "CRYPTO WARN: It's normal to see this on first execution." );
892 my $command = "gpg --keyserver pgp.ipfire.org --always-trust --status-fd 2" ;
893 system ( " $command --recv-key $myid >> $Conf ::logdir/gnupg-database.log 2>&1" );
894 system ( " $command --recv-key $trustid >> $Conf ::logdir/gnupg-database.log 2>&1" );
896 logger
( "CRYPTO INFO: Database is okay" );
901 my ( $data , $response , $protocol ) = @_ ;
902 $final_data .= $data ;
903 print progress_bar
( length ( $final_data ), $total_size , 30 , '=' );
907 my ( $got , $total , $width , $char ) = @_ ;
909 $width ||= 30 ; $char ||= '=' ;
910 my $len_bfile = length $bfile ;
911 if ( " $len_bfile " >= "17" ) {
912 $show_bfile = substr ( $bfile , 0 , 17 ). "..." ;
914 $show_bfile = $bfile ;
916 $progress = sprintf ( "%.2f%%" , 100 * $got /+ $total );
917 sprintf " $color {'lightgreen'}%-20s %7s |%-${width}s| %10s $color {'normal'} \r " , $show_bfile , $progress , $char x
(( $width - 1 )* $got / $total ). '>' , beautifysize
( $got );