]>
git.ipfire.org Git - ipfire-2.x.git/blob - src/pakfire/lib/functions.pl
3 require "/opt/pakfire/etc/pakfire.conf" ;
4 require "/var/ipfire/general-functions.pl" ;
17 # A small color-hash :D
19 $color { 'normal' } = " \033 [0m" ;
20 $color { 'black' } = " \033 [0;30m" ;
21 $color { 'darkgrey' } = " \033 [1;30m" ;
22 $color { 'blue' } = " \033 [0;34m" ;
23 $color { 'lightblue' } = " \033 [1;34m" ;
24 $color { 'green' } = " \033 [0;32m" ;
25 $color { 'lightgreen' } = " \033 [1;32m" ;
26 $color { 'cyan' } = " \033 [0;36m" ;
27 $color { 'lightcyan' } = " \033 [1;36m" ;
28 $color { 'red' } = " \033 [0;31m" ;
29 $color { 'lightred' } = " \033 [1;31m" ;
30 $color { 'purple' } = " \033 [0;35m" ;
31 $color { 'lightpurple' } = " \033 [1;35m" ;
32 $color { 'brown' } = " \033 [0;33m" ;
33 $color { 'lightgrey' } = " \033 [0;37m" ;
34 $color { 'yellow' } = " \033 [1;33m" ;
35 $color { 'white' } = " \033 [1;37m" ;
41 my %pakfiresettings = ();
42 & General
:: readhash
( "${General::swroot}/pakfire/settings" , \
%pakfiresettings );
48 if ( " $message " =~ /ERROR/ ) {
49 $message = " $color {'red'} $message $color {'normal'}" ;
50 } elsif ( " $message " =~ /INFO/ ) {
51 $message = " $color {'cyan'} $message $color {'normal'}" ;
52 } elsif ( " $message " =~ /WARN/ ) {
53 $message = " $color {'yellow'} $message $color {'normal'}" ;
54 } elsif ( " $message " =~ /RESV/ ) {
55 $message = " $color {'purple'} $message $color {'normal'}" ;
56 } elsif ( " $message " =~ /INST/ ) {
57 $message = " $color {'green'} $message $color {'normal'}" ;
58 } elsif ( " $message " =~ /REMV/ ) {
59 $message = " $color {'lightred'} $message $color {'normal'}" ;
60 } elsif ( " $message " =~ /UPGR/ ) {
61 $message = " $color {'lightblue'} $message $color {'normal'}" ;
70 system ( "echo \" `date`: $log \" >> /var/log/pakfire.log" );
71 #system("logger -t pakfire \"$log\"");
76 & Pakfire
:: message
( "Usage: pakfire <install|remove> <pak(s)>" );
77 & Pakfire
:: message
( " <update> - Contacts the servers for new lists of paks." );
78 & Pakfire
:: message
( " <upgrade> - Installs the latest version of all paks." );
79 & Pakfire
:: message
( " <list> - Outputs a short list with all available paks." );
80 & Pakfire
:: message
( "" );
87 $p = Net
:: Ping
-> new ();
88 if ( $p -> ping ( $host )) {
89 logger
( "PING INFO: $host is alive" );
92 logger
( "PING INFO: $host is unreachable" );
101 my ( @server , $host , $proto , $file , $allok , $i );
103 logger
( "DOWNLOAD STARTED: $getfile " ) unless ( $bfile =~ /^counter\?.*/ );
105 $bfile = basename
( " $getfile " );
108 while (( $allok == 0 ) && $i < 5 ) {
111 if ( " $gethost " eq "" ) {
112 @server = selectmirror
();
115 $file = " $server [2]/ $getfile " ;
121 $proto = "HTTP" unless $proto ;
123 unless ( $bfile =~ /^counter\?.*/ ) {
124 logger
( "DOWNLOAD INFO: Host: $host ( $proto ) - File: $file " );
125 #message("DOWNLOAD INFO: Loading $bfile from ($proto) $host...");
128 my $ua = LWP
:: UserAgent
-> new ;
129 $ua -> agent ( "Pakfire/ $Conf ::version" );
132 my %proxysettings =();
133 & General
:: readhash
( "${General::swroot}/proxy/advanced/settings" , \
%proxysettings );
135 if ( $proxysettings { 'UPSTREAM_PROXY' }) {
136 logger
( "DOWNLOAD INFO: Upstream proxy: \" $proxysettings {'UPSTREAM_PROXY'} \" " ) unless ( $bfile =~ /^counter\?.*/ );
137 if ( $proxysettings { 'UPSTREAM_USER' }) {
138 $ua -> proxy ( "http" , "http:// $proxysettings {'UPSTREAM_USER'}: $proxysettings {'UPSTREAM_PASSWORD'}@" . " $proxysettings {'UPSTREAM_PROXY'}/" );
139 logger
( "DOWNLOAD INFO: Logging in with: \" $proxysettings {'UPSTREAM_USER'} \" - \" $proxysettings {'UPSTREAM_PASSWORD'} \" " ) unless ( $bfile =~ /^counter\?.*/ );
141 $ua -> proxy ( "http" , "http:// $proxysettings {'UPSTREAM_PROXY'}/" );
146 my $url = "http:// $host / $file " ;
149 unless ( $bfile =~ /^counter\?.*/ ) {
150 my $result = $ua -> head ( $url );
151 my $remote_headers = $result -> headers ;
152 $total_size = $remote_headers -> content_length ;
153 logger
( "DOWNLOAD INFO: $file has size of $total_size bytes" );
155 $response = $ua -> get ( $url , ':content_cb' => \
& callback
);
158 $response = $ua -> get ( $url );
161 my $code = $response -> code ();
162 my $log = $response -> status_line ;
163 logger
( "DOWNLOAD INFO: HTTP-Status-Code: $code - $log " );
165 if ( $code eq "500" ) {
166 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." );
170 if ( $response -> is_success ) {
171 unless ( $bfile =~ /^counter\?.*/ ) {
172 if ( open ( FILE
, "> $Conf ::tmpdir/ $bfile " )) {
173 print FILE
$final_data ;
175 logger
( "DOWNLOAD INFO: File received. Start checking signature..." );
176 if ( system ( "gpg --verify \" $Conf ::tmpdir/ $bfile \" &>/dev/null" ) eq 0 ) {
177 logger
( "DOWNLOAD INFO: Signature of $bfile is fine." );
178 move
( " $Conf ::tmpdir/ $bfile " , " $Conf ::cachedir/ $bfile " );
180 message
( "DOWNLOAD ERROR: The downloaded file ( $file ) wasn't verified by IPFire.org. Sorry - Exiting..." );
183 logger
( "DOWNLOAD FINISHED: $file " );
187 logger
( "DOWNLOAD ERROR: Could not open $Conf ::cachedir/ $bfile for writing." );
193 logger
( "DOWNLOAD ERROR: $log " );
196 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." );
203 logger
( "MIRROR: Trying to get a mirror list." );
205 fetchfile
( " $Conf ::version/lists/server-list.db" , " $Conf ::mainserver" );
206 move
( " $Conf ::cachedir/server-list.db" , " $Conf ::dbdir/lists/server-list.db" );
210 ### Check if there is a current server list and read it.
211 # If there is no list try to get one.
213 while (!( open ( FILE
, "< $Conf ::dbdir/lists/server-list.db" )) && ( $count lt 5 )) {
218 message
( "MIRROR ERROR: Could not find or download a server list" );
224 ### Count the number of the servers in the list
228 if ( " $_ " =~ /.*;.*;.*;/ ) {
233 logger
( "MIRROR INFO: $scount servers found in list" );
235 ### Choose a random server and test if it is online
236 # If the check fails try a new server.
237 # This will never give up.
240 while ( $found == 0 ) {
241 $server = int ( rand ( $scount ) + 1 );
243 my ( $line , $proto , $path , $host );
245 foreach $line ( @newlines ) {
247 if ( $servers eq $server ) {
248 @templine = split ( /\;/ , $line );
249 $proto = $templine [ 0 ];
250 $host = $templine [ 1 ];
251 $path = $templine [ 2 ];
252 if ( pinghost
( " $host " )) {
254 return ( $proto , $host , $path );
262 ### Update the database if the file is older than one day.
263 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
264 # Usage is always with an argument.
270 if ( - e
" $Conf ::dbdir/lists/packages_list.db" ) {
271 my @stat = stat ( " $Conf ::dbdir/lists/packages_list.db" );
273 $age = $time - $stat [ 9 ];
279 if (( " $age " gt "86400" ) || ( " $force " eq "force" )) {
280 fetchfile
( "lists/packages_list.db" , "" );
281 move
( " $Conf ::cachedir/packages_list.db" , " $Conf ::dbdir/lists/packages_list.db" );
286 ### This subroutine lists the packages.
287 # You may also pass a filter: &Pakfire::dblist(filter)
288 # Usage is always with two arguments.
289 # filter may be: all, notinstalled, installed
297 my ( $name , $version , $release );
300 ### Make sure that the list is not outdated.
301 dbgetlist
( "noforce" );
303 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
307 if ( " $filter " eq "upgrade" ) {
308 opendir ( DIR
, " $Conf ::dbdir/meta" );
309 my @files = readdir ( DIR
);
311 foreach $file ( @files ) {
312 next if ( $file eq "." );
313 next if ( $file eq ".." );
314 open ( FILE
, "< $Conf ::dbdir/meta/ $file " );
317 foreach $line ( @meta ) {
318 @templine = split ( /\: / , $line );
319 if ( " $templine [0]" eq "Name" ) {
320 $name = $templine [ 1 ];
322 } elsif ( " $templine [0]" eq "ProgVersion" ) {
323 $version = $templine [ 1 ];
325 } elsif ( " $templine [0]" eq "Release" ) {
326 $release = $templine [ 1 ];
330 foreach $prog ( @db ) {
331 @templine = split ( /\;/ , $prog );
332 if (( " $name " eq " $templine [0]" ) && ( " $release " < " $templine [2]" )) {
333 push ( @updatepaks , $name );
334 if ( " $forweb " eq "forweb" ) {
335 print "<option value= \" $name \" >Update: $name -- Version: $version -> $templine [1] -- Release: $release -> $templine [2]</option> \n " ;
337 print "Update: $name \n Version: $version -> $templine [1] \n Release: $release -> $templine [2] \n\n " ;
346 foreach $line ( sort @db ) {
347 next unless ( $line =~ /.*;.*;.*;/ );
348 @templine = split ( /\;/ , $line );
349 if ( " $filter " eq "notinstalled" ) {
350 next if ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
351 } elsif ( " $filter " eq "installed" ) {
352 next unless ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
354 if ( " $forweb " eq "forweb" ) {
355 print "<option value= \" $templine [0] \" > $templine [0]- $templine [1]- $templine [2]</option> \n " ;
357 print "Name: $templine [0] \n ProgVersion: $templine [1] \n Release: $templine [2] \n\n " ;
368 message
( "PAKFIRE RESV: $pak : Resolving dependencies..." );
370 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
375 my ( @templine , @deps , @tempdeps , @all );
376 foreach $line ( @file ) {
377 @templine = split ( /\: / , $line );
378 if ( " $templine [0]" eq "Dependencies" ) {
379 @deps = split ( / / , $templine [ 1 ]);
385 my $return = & isinstalled
( $_ );
387 message
( "PAKFIRE RESV: $pak : Dependency is already installed: $_ " );
389 message
( "PAKFIRE RESV: $pak : Need to install dependency: $_ " );
396 foreach ( @tempdeps ) {
398 my @newdeps = resolvedeps
( " $_ " );
400 unless (( $_ eq " " ) || ( $_ eq "" )) {
401 my $return = & isinstalled
( $_ );
403 message
( "PAKFIRE RESV: $pak : Dependency is already installed: $_ " );
405 message
( "PAKFIRE RESV: $pak : Need to install dependency: $_ " );
421 logger
( "CLEANUP: $dir " );
423 if ( " $dir " eq "meta" ) {
424 $path = " $Conf ::dbdir/meta" ;
425 } elsif ( " $dir " eq "tmp" ) {
426 $path = " $Conf ::tmpdir" ;
430 my @files = readdir ( DIR
);
433 unless (( $_ eq "." ) || ( $_ eq ".." )) {
442 unless ( - e
" $Conf ::dbdir/meta/meta- $pak " ) {
443 fetchfile
( "meta/meta- $pak " , "" );
444 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
447 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
451 open ( FILE
, "> $Conf ::dbdir/meta/meta- $pak " );
454 $string =~ s/\r\n/\n/g ;
466 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
472 foreach $line ( @file ) {
473 @templine = split ( /\: / , $line );
474 if ( " $templine [0]" eq "Size" ) {
487 my $file = getpak
( " $pak " , "noforce" );
489 logger
( "DECRYPT STARTED: $pak " );
490 my $return = system ( "cd $Conf ::tmpdir/ && gpg -d --batch --quiet --no-verbose --status-fd 2 --output - < $Conf ::cachedir/ $file 2>/dev/null | tar x" );
492 logger
( "DECRYPT FINISHED: $pak - Status: $return " );
493 if ( $return != 0 ) { exit 1 ; }
502 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
509 foreach $line ( @file ) {
510 @templine = split ( /\: / , $line );
511 if ( " $templine [0]" eq "File" ) {
513 $file = $templine [ 1 ];
518 message
( "No filename given in meta-file. Please phone the developers." );
522 unless ( " $force " eq "force" ) {
523 if ( - e
" $Conf ::cachedir/ $file " ) {
528 fetchfile
( "paks/ $file " , "" );
535 message
( "PAKFIRE INST: $pak : Decrypting..." );
538 message
( "PAKFIRE INST: $pak : Copying files and running post-installation scripts..." );
539 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./install.sh >> $Conf ::logdir/install- $pak .log 2>&1" );
541 if ( $pakfiresettings { 'UUID' } ne "off" ) {
542 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid&ipak= $pak &return= $return " , " $Conf ::mainserver" );
545 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
547 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
548 message
( "PAKFIRE INST: $pak : Finished." );
551 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
559 if ( open ( FILE
, "< $Conf ::dbdir/installed/meta- $pak " ) ) {
570 message
( "PAKFIRE UPGR: $pak : Decrypting..." );
573 message
( "PAKFIRE UPGR: $pak : Upgrading files and running post-upgrading scripts..." );
574 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./update.sh >> $Conf ::logdir/update- $pak .log 2>&1" );
576 if ( $pakfiresettings { 'UUID' } ne "off" ) {
577 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid&upak= $pak &return= $return " , " $Conf ::mainserver" );
580 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
582 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
583 message
( "PAKFIRE UPGR: $pak : Finished." );
586 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
595 message
( "PAKFIRE REMV: $pak : Decrypting..." );
598 message
( "PAKFIRE REMV: $pak : Removing files and running post-removing scripts..." );
599 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./uninstall.sh >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
601 if ( $pakfiresettings { 'UUID' } ne "off" ) {
602 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid&dpak= $pak &return= $return " , " $Conf ::mainserver" );
605 open ( FILE
, "< $Conf ::dbdir/rootfiles/ $pak " );
611 system ( "echo \" Removing: $line \" >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
612 system ( "cd / && rm -rf $line >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
614 unlink ( " $Conf ::dbdir/rootfiles/ $pak " );
615 unlink ( " $Conf ::dbdir/installed/meta- $pak " );
617 message
( "PAKFIRE REMV: $pak : Finished." );
620 message
( "PAKFIRE ERROR: Returncode: $return . Sorry. Please search our forum to find a solution for this problem." );
628 #$size = $size / 1024;
631 if ( $size > 1023 * 1024 ) {
632 $size = ( $size / ( 1024 * 1024 ));
634 } elsif ( $size > 1023 ) {
635 $size = ( $size / 1024 );
640 $size = sprintf ( "%.2f" , $size );
641 my $string = " $size $unit " ;
646 unless ( - e
" $Conf ::dbdir/uuid" ) {
647 open ( FILE
, "</proc/sys/kernel/random/uuid" );
651 open ( FILE
, "> $Conf ::dbdir/uuid" );
660 if ( $pakfiresettings { 'UUID' } ne "off" ) {
661 unless ( " $Conf ::uuid" ) {
662 $Conf :: uuid
= `cat $Conf ::dbdir/uuid` ;
664 logger
( "Sending my uuid: $Conf ::uuid" );
665 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid" , " $Conf ::mainserver" );
666 system ( "rm -f $Conf ::tmpdir/counter* 2>/dev/null" );
671 logger
( "CRYPTO INFO: Checking GnuPG Database" );
672 my $myid = "64D96617" ; # Our own gpg-key
673 my $trustid = "65D0FD58" ; # Id of CaCert
674 my $ret = system ( "gpg --list-keys | grep -q $myid " );
675 unless ( " $ret " eq "0" ) {
676 message
( "CRYPTO WARN: The GnuPG isn't configured corectly. Trying now to fix this." );
677 message
( "CRYPTO WARN: It's normal to see this on first execution." );
678 system ( "gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $myid &>> $Conf ::logdir/gnupg-database.log" );
679 system ( "gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid &>> $Conf ::logdir/gnupg-database.log" );
681 logger
( "CRYPTO INFO: Database is okay" );
686 my ( $data , $response , $protocol ) = @_ ;
687 $final_data .= $data ;
688 print progress_bar
( length ( $final_data ), $total_size , 30 , '=' );
692 my ( $got , $total , $width , $char ) = @_ ;
694 $width ||= 30 ; $char ||= '=' ;
695 my $len_bfile = length $bfile ;
696 if ( " $len_bfile " >= "17" ) {
697 $show_bfile = substr ( $bfile , 0 , 17 ). "..." ;
699 $show_bfile = $bfile ;
701 $progress = sprintf ( "%.2f%%" , 100 * $got /+ $total );
702 sprintf " $color {'lightgreen'}%-20s %7s |%-${width}s| %10s $color {'normal'} \r " , $show_bfile , $progress , $char x
(( $width - 1 )* $got / $total ). '>' , beautifysize
( $got );