]>
git.ipfire.org Git - ipfire-2.x.git/blob - src/pakfire/lib/functions.pl
3 require "/opt/pakfire/etc/pakfire.conf" ;
21 system ( "logger -t pakfire \" $log \" " );
25 & Pakfire
:: message
( "Usage: pakfire <install|remove> <pak(s)>" );
26 & Pakfire
:: message
( " <update> - Contacts the servers for new lists of paks." );
27 & Pakfire
:: message
( " <upgrade> - Installs the latest version of a pak." );
28 & Pakfire
:: message
( " <list> - Outputs a short list with all available paks." );
35 $p = Net
:: Ping
-> new ();
36 if ( $p -> ping ( $host )) {
37 logger
( " $host is alive." );
40 logger
( " $host is dead." );
49 my ( @server , $host , $proto , $file , $allok , $i );
52 $bfile = basename
( " $getfile " );
55 while (( $allok == 0 ) && $i < 5 ) {
58 if ( " $gethost " eq "" ) {
59 @server = selectmirror
();
62 $file = " $server [2]/ $getfile " ;
68 $proto = "HTTP" unless $proto ;
70 logger
( "Trying to get $file from $host ( $proto )." );
72 my $ua = LWP
:: UserAgent
-> new ;
73 $ua -> agent ( "Pakfire/ $Conf ::version" );
77 my $response = $ua -> get ( "http:// $host / $file " );
79 if ( $response -> is_success ) {
80 logger
( " $host sends file: $file ." );
81 if ( open ( FILE
, "> $Conf ::cachedir/ $bfile " )) {
82 print FILE
$response -> content ;
87 logger
( "Could not open $Conf ::cachedir/ $bfile for writing." );
90 my $log = $response -> status_line ;
91 logger
( "Download $file failed from $host ( $proto ): $log " );
94 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." );
101 logger
( "Try to get a mirror list." );
103 fetchfile
( "lists/ $Conf ::version-server-list" , " $Conf ::mainserver" );
104 move
( " $Conf ::cachedir/ $Conf ::version-server-list" , " $Conf ::dbdir/lists/ $Conf ::version-server-list" );
108 ### Check if there is a current server list and read it.
109 # If there is no list try to get one.
111 while (!( open ( FILE
, "< $Conf ::dbdir/lists/ $Conf ::version-server-list" )) && ( $count lt 5 )) {
116 message
( "Could not find or download a server list." );
122 ### Count the number of the servers in the list
127 logger
( " $scount servers found in list." );
129 ### Choose a random server and test if it is online
130 # If the check fails try a new server.
131 # This will never give up.
134 while ( $found == 0 ) {
135 $server = int ( rand ( $scount ) + 1 );
137 my ( $line , $proto , $path , $host );
139 foreach $line ( @lines ) {
141 if ( $servers eq $server ) {
142 @templine = split ( /\;/ , $line );
143 $proto = $templine [ 0 ];
144 $host = $templine [ 1 ];
145 $path = $templine [ 2 ];
146 if ( pinghost
( " $host " )) {
148 return ( $proto , $host , $path );
156 ### Update the database if the file is older than one day.
157 # If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
158 # Usage is always with an argument.
164 if ( - e
" $Conf ::dbdir/lists/packages_list.db" ) {
165 my @stat = stat ( " $Conf ::dbdir/lists/packages_list.db" );
167 $age = $time - $stat [ 9 ];
173 if (( " $age " gt 86400 ) || ( " $force " eq "force" )) {
175 fetchfile
( "lists/packages_list.db" , "" );
176 move
( " $Conf ::cachedir/packages_list.db" , " $Conf ::dbdir/lists/packages_list.db" );
181 ### This subroutine lists the packages.
182 # You may also pass a filter: &Pakfire::dblist(filter)
183 # Usage is always with two arguments.
184 # filter may be: all, notinstalled, installed
188 ### Make sure that the list is not outdated.
189 dbgetlist
( "noforce" );
191 open ( FILE
, "< $Conf ::dbdir/lists/packages_list.db" );
197 foreach $line ( sort @db ) {
198 @templine = split ( /\;/ , $line );
199 if ( " $filter " eq "notinstalled" ) {
200 next if ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
201 } elsif ( " $filter " eq "installed" ) {
202 next unless ( - e
" $Conf ::dbdir/installed/meta- $templine [0]" );
204 if ( " $forweb " eq "forweb" ) {
205 print "<option value= \" $templine [0] \" > $templine [0]- $templine [1]- $templine [2]</option> \n " ;
207 print "Name: $templine [0] \n Version: $templine [1] \n Release: $templine [2] \n\n " ;
217 message
( " \n ## Resolving dependencies for $pak ..." );
219 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
224 my ( @templine , @deps , @tempdeps );
225 foreach $line ( @file ) {
226 @templine = split ( /\: / , $line );
227 if ( " $templine [0]" eq "Dependencies" ) {
228 @deps = split ( / / , $templine [ 1 ]);
234 message
( "### Found dependency: $_ " );
239 #my @tempdeps = @deps;
240 foreach ( @tempdeps ) {
242 my @newdeps = resolvedeps
( " $_ " );
244 unless (( $_ eq " " ) || ( $_ eq "" )) {
245 message
( "### Found dependency: $_ " );
259 if ( " $dir " eq "meta" ) {
260 $path = " $Conf ::dbdir/meta" ;
261 } elsif ( " $dir " eq "tmp" ) {
262 $path = " $Conf ::tmpdir" ;
266 my @files = readdir ( DIR
);
269 unless (( $_ eq "." ) || ( $_ eq ".." )) {
278 logger
( "Going to download meta- $pak ." );
280 unless ( - e
" $Conf ::dbdir/meta/meta- $pak " ) {
281 fetchfile
( "meta/meta- $pak " , "" );
282 move
( " $Conf ::cachedir/meta- $pak " , " $Conf ::dbdir/meta/meta- $pak " );
285 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
289 open ( FILE
, "> $Conf ::dbdir/meta/meta- $pak " );
292 $string =~ s/\r\n/\n/g ;
304 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
310 foreach $line ( @file ) {
311 @templine = split ( /\: / , $line );
312 if ( " $templine [0]" eq "Size" ) {
319 sub addsizes
{ ## Still not working
325 $paksize = getsize
( " $_ " );
326 $totalsize = ( $totalsize + $paksize ) ;
336 my $file = getpak
( " $pak " , "noforce" );
338 my $return = system ( "gpg -d < $Conf ::cachedir/ $file | tar xj -C $Conf ::tmpdir/" );
340 logger
( "Decryption process returned the following: $return " );
341 if ( $return != 1 ) { exit 1 ; }
350 open ( FILE
, "< $Conf ::dbdir/meta/meta- $pak " );
357 foreach $line ( @file ) {
358 @templine = split ( /\: / , $line );
359 if ( " $templine [0]" eq "File" ) {
361 $file = $templine [ 1 ];
366 message
( "No filename given in meta-file. Please phone the developers." );
370 unless ( " $force " eq "force" ) {
371 if ( - e
" $Conf ::cachedir/ $file " ) {
376 fetchfile
( "paks/ $file " , "" );
383 message
( "We are going to install: $pak " );
387 my $return = system ( "cd $Conf ::tmpdir && ./install.sh >> $Conf ::logdir/install- $pak .log 2>&1" );
389 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
391 copy
( " $Conf ::dbdir/meta/meta- $pak " , " $Conf ::dbdir/installed/" );
392 message
( "Setup completed. Congratulations!" );
394 message
( "Setup returned: $return . Sorry. Please search our forum to find a solution for this problem." );
403 message
( "We are going to update: $pak " );
407 my $return = system ( "cd $Conf ::tmpdir && ./update.sh >> $Conf ::logdir/update- $pak .log 2>&1" );
409 move
( " $Conf ::tmpdir/ROOTFILES" , " $Conf ::dbdir/rootfiles/ $pak " );
411 message
( "Update completed. Congratulations!" );
413 message
( "Setup returned: $return . Sorry. Please search our forum to find a solution for this problem." );
422 message
( "We are going to uninstall: $pak " );
426 my $return = system ( "cd $Conf ::tmpdir && ./uninstall.sh >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
428 open ( FILE
, "< $Conf ::dbdir/rootfiles/ $pak " );
434 system ( "echo \" Removing: $line \" >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
435 system ( "cd / && rm -rf $line >> $Conf ::logdir/uninstall- $pak .log 2>&1" );
437 unlink ( " $Conf ::dbdir/rootfiles/ $pak " );
439 message
( "Uninstall completed. Congratulations!" );
441 message
( "Setup returned: $return . Sorry. Please search our forum to find a solution for this problem." );
449 $size = $size / 1024 ;
453 $size = ( $size / 1024 );
458 $size = sprintf ( "%.2f" , $size );
459 my $string = " $size $unit " ;
464 unless ( - e
" $Conf ::dbdir/uuid" ) {
465 open ( FILE
, "</proc/sys/kernel/random/uuid" );
469 open ( FILE
, "> $Conf ::dbdir/uuid" );
478 unless ( " $Conf ::uuid" ) {
479 $Conf :: uuid
= `cat $Conf ::dbdir/uuid` ;
481 logger
( "Sending my uuid: $Conf ::uuid" );
482 fetchfile
( "cgi-bin/counter?ver= $Conf ::version&uuid= $Conf ::uuid" , " $Conf ::mainserver" );
483 system ( "rm -f $Conf ::cachedir/counter* 2>/dev/null" );
488 if ( " $status " eq "on" ) {
489 system ( "touch /opt/pakfire/pakfire.lock" );
490 system ( "chmod 777 /opt/pakfire/pakfire.lock" );
491 logger
( "Created lock" );
493 if ( system ( "rm -f /opt/pakfire/pakfire.lock >/dev/null 2>&1" )) {
494 logger
( "Successfully removed lock." );
496 logger
( "Couldn't remove lock." );