]>
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" ;
14 my %pakfiresettings = ();
15 & General
:: readhash
( "${General::swroot}/pakfire/settings" , \
%pakfiresettings );
25 system ( "logger -t pakfire \" $log \" " );
29 & Pakfire
:: message
( "Usage: pakfire <install|remove> <pak(s)>" );
30 & Pakfire
:: message
( " <update> - Contacts the servers for new lists of paks." );
31 & Pakfire
:: message
( " <upgrade> - Installs the latest version of all paks." );
32 & Pakfire
:: message
( " <list> - Outputs a short list with all available paks." );
33 & Pakfire
:: message
( "" );
40 $p = Net
:: Ping
-> new ();
41 if ( $p -> ping ( $host )) {
42 logger
( " $host is alive." );
45 logger
( " $host is dead." );
54 my ( @server , $host , $proto , $file , $allok , $i );
57 $bfile = basename
( " $getfile " );
60 while (( $allok == 0 ) && $i < 5 ) {
63 if ( " $gethost " eq "" ) {
64 @server = selectmirror
();
67 $file = " $server [2]/ $getfile " ;
73 $proto = "HTTP" unless $proto ;
75 logger
( "Trying to get $file from $host ( $proto )." );
77 my $ua = LWP
:: UserAgent
-> new ;
78 $ua -> agent ( "Pakfire/ $Conf ::version" );
82 & General
:: readhash
( "${General::swroot}/proxy/advanced/settings" , \
%proxysettings );
84 if ( $proxysettings { 'UPSTREAM_PROXY' }) {
85 logger
( "Using upstream proxy: \" $proxysettings {'UPSTREAM_PROXY'} \" " );
86 if ( $proxysettings { 'UPSTREAM_USER' }) {
87 $ua -> proxy ( "http" , "http:// $proxysettings {'UPSTREAM_USER'}: $proxysettings {'UPSTREAM_PASSWORD'}@" . " $proxysettings {'UPSTREAM_PROXY'}/" );
88 logger
( " Logging in with: \" $proxysettings {'UPSTREAM_USER'} \" - \" $proxysettings {'UPSTREAM_PASSWORD'} \" " );
90 $ua -> proxy ( "http" , "http:// $proxysettings {'UPSTREAM_PROXY'}/" );
94 my $response = $ua -> get ( "http:// $host / $file " );
96 my $code = $response -> code ();
97 my $log = $response -> status_line ;
98 logger
( "HTTP-Status-Code: $code - $log " );
100 if ( $code eq "500" ) {
101 message
( "Giving up: There was no chance to get teh file \" $getfile \" from any available server. \n There was an error on the way. Please fix it." );
105 if ( $response -> is_success ) {
106 if ( open ( FILE
, "> $Conf ::tmpdir/ $bfile " )) {
107 print FILE
$response -> content ;
109 unless ( $bfile =~ /^counter\?.*/ ) { # Don't check out counterfile cause it's empty
110 logger
( "File received. Start checking signature..." );
111 if ( system ( "gpg --verify \" $Conf ::tmpdir/ $bfile \" &>/dev/null" ) eq 0 ) {
112 logger
( "Signature of $bfile is fine." );
113 move
( " $Conf ::tmpdir/ $bfile " , " $Conf ::cachedir/ $bfile " );
115 message
( "The downloaded file ( $file ) wasn't verified by IPFire.org. Sorry - Exiting..." );
119 logger
( "Download successfully done from $host (file: $file )." );
123 logger
( "Could not open $Conf ::cachedir/ $bfile for writing." );
126 logger
( "Download $file failed from $host ( $proto ): $log " );
129 message
( "Giving up: 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." );
136 logger
( "Try to get a mirror list." );
138 fetchfile
( " $Conf ::version/lists/server-list.db" , " $Conf ::mainserver" );
139 move
( " $Conf ::cachedir/server-list.db" , " $Conf ::dbdir/lists/server-list.db" );
143 ### Check if there is a current server list and read it.
144 # If there is no list try to get one.
146 while (!( open ( FILE
, "< $Conf ::dbdir/lists/server-list.db" )) && ( $count lt 5 )) {
151 message
( "Could not find or download a server list." );
157 ### Count the number of the servers in the list
162 logger
( " $scount servers found in list." );
164 ### Choose a random server and test if it is online
165 # If the check fails try a new server.
166 # This will never give up.
169 while ( $found == 0 ) {
170 $server = int ( rand ( $scount ) + 1 );
172 my ( $line , $proto , $path , $host );
174 foreach $line ( @lines ) {
176 if ( $servers eq $server ) {
177 @templine = split ( /\;/ , $line );
178 $proto = $templine [ 0 ];
179 $host = $templine [ 1 ];
180 $path = $templine [ 2 ];
181 if ( pinghost
( " $host " )) {
183 return ( $proto , $host , $path );
191 ### Update the database if the file is older than one day.
192 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
193 # Usage is always with an argument.
199 if ( - e
" $Conf ::dbdir/lists/packages_list.db" ) {
200 my @stat = stat ( " $Conf ::dbdir/lists/packages_list.db" );
202 $age = $time - $stat [ 9 ];
208 if (( " $age " gt 86400 ) || ( " $force " eq "force" )) {
210 fetchfile
( "lists/packages_list.db" , "" );
211 move
( " $Conf ::cachedir/packages_list.db" , " $Conf ::dbdir/lists/packages_list.db" );
216 ### This subroutine lists the packages.
217 # You may also pass a filter: &Pakfire::dblist(filter)
218 # Usage is always with two arguments.
219 # filter may be: all, notinstalled, installed
227 my ( $name , $version , $release );
230 ### Make sure that the list is not outdated.
231 dbgetlist
( "noforce" );
233 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
237 if ( " $filter " eq "upgrade" ) {
238 opendir ( DIR
, " $Conf ::dbdir/meta" );
239 my @files = readdir ( DIR
);
241 foreach $file ( @files ) {
242 next if ( $file eq "." );
243 next if ( $file eq ".." );
244 open ( FILE
, "< $Conf ::dbdir/meta/ $file " );
247 foreach $line ( @meta ) {
248 @templine = split ( /\: / , $line );
249 if ( " $templine [0]" eq "Name" ) {
250 $name = $templine [ 1 ];
252 } elsif ( " $templine [0]" eq "ProgVersion" ) {
253 $version = $templine [ 1 ];
255 } elsif ( " $templine [0]" eq "Release" ) {
256 $release = $templine [ 1 ];
260 foreach $prog ( @db ) {
261 @templine = split ( /\;/ , $prog );
262 if (( " $name " eq " $templine [0]" ) && ( " $release " < " $templine [2]" )) {
263 push ( @updatepaks , $name );
264 if ( " $forweb " eq "forweb" ) {
265 print "<option value= \" $name \" >Update: $name -- Version: $version -> $templine [1] -- Release: $release -> $templine [2]</option> \n " ;
267 print "Update: $name \n Version: $version -> $templine [1] \n Release: $release -> $templine [2] \n\n " ;
276 foreach $line ( sort @db ) {
277 next unless ( $line =~ /.*;.*;.*;/ );
278 @templine = split ( /\;/ , $line );
279 if ( " $filter " eq "notinstalled" ) {
280 next if ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
281 } elsif ( " $filter " eq "installed" ) {
282 next unless ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
284 if ( " $forweb " eq "forweb" ) {
285 print "<option value= \" $templine [0] \" > $templine [0]- $templine [1]- $templine [2]</option> \n " ;
287 print "Name: $templine [0] \n ProgVersion: $templine [1] \n Release: $templine [2] \n\n " ;
299 message
( "## Resolving dependencies for $pak ..." );
300 #if (&isinstalled($pak) eq 0) {
305 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
310 my ( @templine , @deps , @tempdeps , @all );
311 foreach $line ( @file ) {
312 @templine = split ( /\: / , $line );
313 if ( " $templine [0]" eq "Dependencies" ) {
314 @deps = split ( / / , $templine [ 1 ]);
320 my $return = & isinstalled
( $_ );
322 message
( "### Dependency is already installed: $_ " );
324 message
( "### Need to install dependency: $_ " );
331 #my @tempdeps = @deps;
332 foreach ( @tempdeps ) {
334 my @newdeps = resolvedeps
( " $_ " );
336 unless (( $_ eq " " ) || ( $_ eq "" )) {
337 my $return = & isinstalled
( $_ );
339 message
( "### Dependency is already installed: $_ " );
341 message
( "### Need to install dependency: $_ " );
356 if ( " $dir " eq "meta" ) {
357 $path = " $Conf ::dbdir/meta" ;
358 } elsif ( " $dir " eq "tmp" ) {
359 $path = " $Conf ::tmpdir" ;
363 my @files = readdir ( DIR
);
366 unless (( $_ eq "." ) || ( $_ eq ".." )) {
375 logger
( "Going to download meta- $pak ." );
377 unless ( - e
" $Conf ::dbdir/meta/meta- $pak " ) {
378 fetchfile
( "meta/meta- $pak " , "" );
379 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
382 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
386 open ( FILE
, "> $Conf ::dbdir/meta/meta- $pak " );
389 $string =~ s/\r\n/\n/g ;
401 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
407 foreach $line ( @file ) {
408 @templine = split ( /\: / , $line );
409 if ( " $templine [0]" eq "Size" ) {
422 my $file = getpak
( " $pak " , "noforce" );
424 my $return = system ( "cd $Conf ::tmpdir/ && gpg -d < $Conf ::cachedir/ $file | tar x >/dev/null 2>&1" );
426 logger
( "Decryption process returned the following: $return " );
427 if ( $return != 0 ) { exit 1 ; }
436 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
443 foreach $line ( @file ) {
444 @templine = split ( /\: / , $line );
445 if ( " $templine [0]" eq "File" ) {
447 $file = $templine [ 1 ];
452 message
( "No filename given in meta-file. Please phone the developers." );
456 unless ( " $force " eq "force" ) {
457 if ( - e
" $Conf ::cachedir/ $file " ) {
462 fetchfile
( "paks/ $file " , "" );
469 message
( "################################################################################" );
470 message
( "# --> Installing: $pak " );
471 message
( "################################################################################" );
475 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./install.sh >> $Conf ::logdir/install- $pak .log 2>&1" );
478 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
480 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
481 message
( "Setup completed. Congratulations!" );
482 message
( "################################################################################" );
483 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid&ipak= $pak &return= $return " , " $Conf ::mainserver" );
485 message
( "Setup returned: $return . Sorry. Please search our forum to find a solution for this problem." );
493 if ( open ( FILE
, "< $Conf ::dbdir/installed/meta- $pak " ) ) {
504 message
( "We are going to upgrade: $pak " );
508 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./update.sh >> $Conf ::logdir/update- $pak .log 2>&1" );
511 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
513 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
514 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid&upak= $pak &return= $return " , " $Conf ::mainserver" );
515 message
( "Upgrade completed. Congratulations!" );
517 message
( "Setup returned: $return . Sorry. Please search our forum to find a solution for this problem." );
526 message
( "We are going to uninstall: $pak " );
530 my $return = system ( "cd $Conf ::tmpdir && NAME= $pak ./uninstall.sh >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
533 open ( FILE
, "< $Conf ::dbdir/rootfiles/ $pak " );
539 system ( "echo \" Removing: $line \" >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
540 system ( "cd / && rm -rf $line >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
542 unlink ( " $Conf ::dbdir/rootfiles/ $pak " );
544 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid&dpak= $pak &return= $return " , " $Conf ::mainserver" );
545 message
( "Uninstall completed. Congratulations!" );
547 message
( "Setup returned: $return . Sorry. Please search our forum to find a solution for this problem." );
555 $size = $size / 1024 ;
559 $size = ( $size / 1024 );
564 $size = sprintf ( "%.2f" , $size );
565 my $string = " $size $unit " ;
570 unless ( - e
" $Conf ::dbdir/uuid" ) {
571 open ( FILE
, "</proc/sys/kernel/random/uuid" );
575 open ( FILE
, "> $Conf ::dbdir/uuid" );
584 if ( $pakfiresettings { 'UUID' } ne "off" ) {
585 unless ( " $Conf ::uuid" ) {
586 $Conf :: uuid
= `cat $Conf ::dbdir/uuid` ;
588 logger
( "Sending my uuid: $Conf ::uuid" );
589 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid" , " $Conf ::mainserver" );
590 system ( "rm -f $Conf ::tmpdir/counter* 2>/dev/null" );
595 my $myid = "64D96617" ; # Our own gpg-key
596 my $trustid = "65D0FD58" ; # Id of CaCert
597 my $ret = system ( "gpg --list-keys | grep -q $myid " );
598 unless ( " $ret " eq "0" ) {
599 message
( "The GnuPG isn't configured corectly. Trying now to fix this." );
600 system ( "gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $myid " );
601 system ( "gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid " );