src/pakfire/lib/functions.pl

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