src/pakfire/lib/functions.pl

   1 #!/usr/bin/perl -w
   2
   3 require "/opt/pakfire/etc/pakfire.conf";
   4
   5 use File::Basename;
   6 use File::Copy;
   7 use LWP::UserAgent;
   8 use HTTP::Response;
   9 use Net::Ping;
  10
  11 package Pakfire;
  12
  13 sub message {
  14         my $message = shift;
  15         print "$message\n";
  16         logger("$message");
  17 }
  18
  19 sub logger {
  20         my $log = shift;
  21         system("logger -t pakfire \"$log\"");
  22 }
  23
  24 sub usage {
  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.");
  29   exit 1;
  30 }
  31
  32 sub pinghost {
  33         my $host = shift;
  34
  35         $p = Net::Ping->new();
  36   if ($p->ping($host)) {
  37         logger("$host is alive.");
  38         return 1;
  39   } else {
  40                 logger("$host is dead.");
  41                 return 0;
  42         }
  43   $p->close();
  44 }
  45
  46 sub fetchfile {
  47         my $getfile = shift;
  48         my $gethost = shift;
  49         my (@server, $host, $proto, $file, $allok, $i);
  50
  51         use File::Basename;
  52         $bfile = basename("$getfile");
  53
  54         $i = 0;
  55         while (($allok == 0) && $i < 5) {
  56                 $i++;
  57
  58                 if ("$gethost" eq "") {
  59                         @server = selectmirror();
  60                         $proto = $server[0];
  61                         $host = $server[1];
  62                         $file = "$server[2]/$getfile";
  63                 } else {
  64                         $host = $gethost;
  65                         $file = $getfile;
  66                 }
  67
  68                 $proto = "HTTP" unless $proto;
  69
  70                 logger("Trying to get $file from $host ($proto).");
  71
  72                 my $ua = LWP::UserAgent->new;
  73                 $ua->agent("Pakfire/$Conf::version");
  74                 $ua->timeout(5);
  75                 #$ua->env_proxy;
  76
  77                 my $response = $ua->get("http://$host/$file");
  78
  79                 if ($response->is_success) {
  80                         logger("$host sends file: $file.");
  81                         if (open(FILE, ">$Conf::cachedir/$bfile")) {
  82                                 print FILE $response->content;
  83                                 close(FILE);
  84                                 $allok = 1;
  85                                 return 0;
  86                         } else {
  87                                 logger("Could not open $Conf::cachedir/$bfile for writing.");
  88                         }
  89                 }       else {
  90                         my $log = $response->status_line;
  91                         logger("Download $file failed from $host ($proto): $log");
  92                 }
  93         }
  94         message("Giving up: There was no chance to get the file \"$getfile\" from any available server.\nMay be you should run \"pakfire update\" to get some new servers.");
  95         return 1;
  96 }
  97
  98 sub getmirrors {
  99         use File::Copy;
 100
 101         logger("Try to get a mirror list.");
 102
 103         fetchfile("lists/$Conf::version-server-list", "$Conf::mainserver");
 104         move("$Conf::cachedir/$Conf::version-server-list", "$Conf::dbdir/lists/$Conf::version-server-list");
 105 }
 106
 107 sub selectmirror {
 108         ### Check if there is a current server list and read it.
 109         #   If there is no list try to get one.
 110         my $count = 0;
 111         while (!(open(FILE, "<$Conf::dbdir/lists/$Conf::version-server-list")) && ($count lt 5)) {
 112                 $count++;
 113                 getmirrors();
 114         }
 115         if ($count == 5) {
 116                 message("Could not find or download a server list.");
 117                 exit 1;
 118         }
 119         my @lines = <FILE>;
 120         close(FILE);
 121
 122         ### Count the number of the servers in the list
 123         my $scount = 0;
 124         foreach (@lines) {
 125                 $scount++;
 126         }
 127         logger("$scount servers found in list.");
 128
 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.
 132         my $found = 0;
 133         my $servers = 0;
 134         while ($found == 0) {
 135                 $server = int(rand($scount) + 1);
 136                 $servers = 0;
 137                 my ($line, $proto, $path, $host);
 138                 my @templine;
 139                 foreach $line (@lines) {
 140                         $servers++;
 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")) {
 147                                         $found = 1;
 148                                         return ($proto, $host, $path);
 149                                 }
 150                         }
 151                 }
 152         }
 153 }
 154
 155 sub dbgetlist {
 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.
 159         my $force = shift;
 160         my $age;
 161
 162         use File::Copy;
 163
 164         if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
 165                 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
 166                 my $time = time();
 167                 $age = $time - $stat[9];
 168         } else {
 169                 # Force an update.
 170                 $age = "86401";
 171         }
 172
 173         if (("$age" gt 86400) || ("$force" eq "force")) {
 174                 #cleanup();
 175                 fetchfile("lists/packages_list.db", "");
 176                 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
 177         }
 178 }
 179
 180 sub dblist {
 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
 185         my $filter = shift;
 186         my $forweb = shift;
 187
 188         ### Make sure that the list is not outdated.
 189         dbgetlist("noforce");
 190
 191         open(FILE, "<$Conf::dbdir/lists/packages_list.db");
 192         my @db = <FILE>;
 193         close(FILE);
 194
 195         my $line;
 196         my @templine;
 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]" );
 203                 }
 204                 if ("$forweb" eq "forweb") {
 205                         print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
 206                 } else {
 207                         print "Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]\n\n";
 208                 }
 209         }
 210 }
 211
 212 sub resolvedeps {
 213         my $pak = shift;
 214
 215         getmetafile("$pak");
 216
 217         message("\n## Resolving dependencies for $pak...");
 218
 219         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 220         my @file = <FILE>;
 221         close(FILE);
 222
 223         my $line;
 224         my (@templine, @deps, @tempdeps);
 225         foreach $line (@file) {
 226                 @templine = split(/\: /,$line);
 227                 if ("$templine[0]" eq "Dependencies") {
 228                         @deps = split(/ /, $templine[1]);
 229                 }
 230         }
 231         chomp (@deps);
 232         foreach (@deps) {
 233                 if ($_) {
 234                   message("### Found dependency: $_");
 235                   push(@tempdeps,$_);
 236                 }
 237         }
 238
 239         #my @tempdeps = @deps;
 240         foreach (@tempdeps) {
 241                 if ($_) {
 242                         my @newdeps = resolvedeps("$_");
 243                         foreach(@newdeps) {
 244                                 unless (($_ eq " ") || ($_ eq "")) {
 245                                   message("### Found dependency: $_");
 246                                         push(@deps,$_);
 247                                 }
 248                         }
 249                 }
 250         }
 251         chomp (@deps);
 252         return @deps;
 253 }
 254
 255 sub cleanup {
 256         my $dir = shift;
 257         my $path;
 258
 259         if ( "$dir" eq "meta" ) {
 260                 $path = "$Conf::dbdir/meta";
 261         } elsif ( "$dir" eq "tmp" ) {
 262                 $path = "$Conf::tmpdir";
 263         }
 264         chdir("$path");
 265         opendir(DIR,".");
 266         my @files = readdir(DIR);
 267         closedir(DIR);
 268         foreach (@files) {
 269           unless (($_ eq ".") || ($_ eq "..")) {
 270                    system("rm -rf $_");
 271                 }
 272         }
 273 }
 274
 275 sub getmetafile {
 276         my $pak = shift;
 277
 278         logger("Going to download meta-$pak.");
 279
 280         unless ( -e "$Conf::dbdir/meta/meta-$pak") {
 281                 fetchfile("meta/meta-$pak", "");
 282                 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
 283         }
 284
 285         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 286         my @line = <FILE>;
 287         close(FILE);
 288
 289         open(FILE, ">$Conf::dbdir/meta/meta-$pak");
 290         foreach (@line) {
 291                 my $string = $_;
 292                 $string =~ s/\r\n/\n/g;
 293                 print FILE $string;
 294         }
 295         close(FILE);
 296         return 1;
 297 }
 298
 299 sub getsize {
 300         my $pak = shift;
 301
 302         getmetafile("$pak");
 303
 304         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 305         my @file = <FILE>;
 306         close(FILE);
 307
 308         my $line;
 309         my @templine;
 310         foreach $line (@file) {
 311                 @templine = split(/\: /,$line);
 312                 if ("$templine[0]" eq "Size") {
 313                         chomp($templine[1]);
 314                         return $templine[1];
 315                 }
 316         }
 317 }
 318
 319 sub addsizes { ## Still not working
 320         my @paks = shift;
 321
 322         my $paksize;
 323         my $totalsize = 0;
 324         foreach (@paks) {
 325                 $paksize = getsize("$_");
 326                 $totalsize = ($totalsize + $paksize) ;
 327         }
 328         return $totalsize;
 329 }
 330
 331 sub decryptpak {
 332         my $pak = shift;
 333
 334         cleanup("tmp");
 335
 336         my $file = getpak("$pak", "noforce");
 337
 338         my $return = system("cd $Conf::tmpdir/ && gpg -d < $Conf::cachedir/$file | cpio -i >/dev/null 2>&1");
 339
 340         logger("Decryption process returned the following: $return");
 341         if ($return != 0) { exit 1; }
 342 }
 343
 344 sub getpak {
 345         my $pak = shift;
 346         my $force = shift;
 347
 348         getmetafile("$pak");
 349
 350         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 351         my @file = <FILE>;
 352         close(FILE);
 353
 354         my $line;
 355         my $file;
 356         my @templine;
 357         foreach $line (@file) {
 358                 @templine = split(/\: /,$line);
 359                 if ("$templine[0]" eq "File") {
 360                         chomp($templine[1]);
 361                         $file = $templine[1];
 362                 }
 363         }
 364
 365         unless ($file) {
 366                 message("No filename given in meta-file. Please phone the developers.");
 367                 exit 1;
 368         }
 369
 370         unless ( "$force" eq "force" ) {
 371                 if ( -e "$Conf::cachedir/$file" ) {
 372                         return $file;
 373                 }
 374         }
 375
 376         fetchfile("paks/$file", "");
 377         return $file;
 378 }
 379
 380 sub setuppak {
 381         my $pak = shift;
 382
 383         message("We are going to install: $pak");
 384
 385         decryptpak("$pak");
 386
 387         my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
 388         $return %= 255;
 389         if ($return == 0) {
 390           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 391           cleanup("tmp");
 392           copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
 393                 message("Setup completed. Congratulations!");
 394         } else {
 395                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
 396                 exit $return;
 397         }
 398         return $return;
 399 }
 400
 401 sub updatepak {
 402         my $pak = shift;
 403
 404         message("We are going to update: $pak");
 405
 406         decryptpak("$pak");
 407
 408         my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
 409         if ($return == 0) {
 410           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 411           cleanup("tmp");
 412                 message("Update completed. Congratulations!");
 413         } else {
 414                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
 415                 exit $return;
 416         }
 417         return $return;
 418 }
 419
 420 sub removepak {
 421         my $pak = shift;
 422
 423         message("We are going to uninstall: $pak");
 424
 425         decryptpak("$pak");
 426
 427         my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
 428         if ($return == 0) {
 429           open(FILE, "<$Conf::dbdir/rootfiles/$pak");
 430                 my @file = <FILE>;
 431                 close(FILE);
 432                 foreach (@file) {
 433                   my $line = $_;
 434                   chomp($line);
 435                         system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
 436                         system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
 437                 }
 438           unlink("$Conf::dbdir/rootfiles/$pak");
 439           cleanup("tmp");
 440                 message("Uninstall completed. Congratulations!");
 441         } else {
 442                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
 443                 exit $return;
 444         }
 445         return $return;
 446 }
 447
 448 sub beautifysize {
 449         my $size = shift;
 450         $size = $size / 1024;
 451         my $unit;
 452
 453         if ($size > 1023) {
 454           $size = ($size / 1024);
 455           $unit = "MB";
 456         } else {
 457           $unit = "KB";
 458         }
 459         $size = sprintf("%.2f" , $size);
 460         my $string = "$size $unit";
 461         return $string;
 462 }
 463
 464 sub makeuuid {
 465         unless ( -e "$Conf::dbdir/uuid" ) {
 466                 open(FILE, "</proc/sys/kernel/random/uuid");
 467                 my @line = <FILE>;
 468                 close(FILE);
 469
 470                 open(FILE, ">$Conf::dbdir/uuid");
 471                 foreach (@line) {
 472                         print FILE $_;
 473                 }
 474                 close(FILE);
 475         }
 476 }
 477
 478 sub senduuid {
 479         unless("$Conf::uuid") {
 480                 $Conf::uuid = `cat $Conf::dbdir/uuid`;
 481         }
 482         logger("Sending my uuid: $Conf::uuid");
 483         fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
 484         system("rm -f $Conf::cachedir/counter* 2>/dev/null");
 485 }
 486
 487 sub lock {
 488         my $status = shift;
 489         if ("$status" eq "on") {
 490                 system("touch /opt/pakfire/pakfire.lock");
 491                 system("chmod 777 /opt/pakfire/pakfire.lock");
 492                 logger("Created lock");
 493         } else {
 494                 if (system("rm -f /opt/pakfire/pakfire.lock >/dev/null 2>&1")) {
 495                         logger("Successfully removed lock.");
 496                 } else {
 497                         logger("Couldn't remove lock.");
 498                 }
 499         }
 500         return 0;
 501 }
 502
 503 sub checkcryptodb {
 504         my $myid = "64D96617"; # Our own gpg-key
 505         my $trustid = "65D0FD58"; # Id of CaCert
 506         my $ret = system("gpg --list-keys | grep -q $myid");
 507         unless ( "$ret" eq "0" ) {
 508                 message("The GnuPG isn't configured corectly. Trying now to fix this.");
 509                 system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $myid");
 510                 system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid");
 511         }
 512 }
 513
 514 1;