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 pinghost {
  25         my $host = shift;
  26
  27         $p = Net::Ping->new();
  28   if ($p->ping($host)) {
  29         logger("$host is alive.");
  30         return 1;
  31   } else {
  32                 logger("$host is dead.");
  33                 return 0;
  34         }
  35   $p->close();
  36 }
  37
  38 sub fetchfile {
  39         my $getfile = shift;
  40         my $gethost = shift;
  41         my (@server, $host, $proto, $file, $allok, $i);
  42
  43         use File::Basename;
  44         $bfile = basename("$getfile");
  45
  46         $i = 0;
  47         while (($allok == 0) && $i < 5) {
  48                 $i++;
  49
  50                 if ("$gethost" eq "") {
  51                         @server = selectmirror();
  52                         $proto = $server[0];
  53                         $host = $server[1];
  54                         $file = "$server[2]/$getfile";
  55                 } else {
  56                         $host = $gethost;
  57                 }
  58
  59                 $proto = "HTTP" unless $proto;
  60
  61                 logger("Trying to get $file from $host ($proto).");
  62
  63                 my $ua = LWP::UserAgent->new;
  64                 $ua->agent("Pakfire/$Conf::version");
  65                 #$ua->timeout(5);
  66                 #$ua->env_proxy;
  67
  68                 my $response = $ua->get("http://$host/$file");
  69
  70                 if ($response->is_success) {
  71                         logger("$host sends file: $file.");
  72                         if (open(FILE, ">$Conf::cachedir/$bfile")) {
  73                                 print FILE $response->content;
  74                                 close(FILE);
  75                                 $allok = 1;
  76                                 return 0;
  77                         } else {
  78                                 logger("Could not open $Conf::cachedir/$bfile for writing.");
  79                         }
  80                 }       else {
  81                         my $log = $response->status_line;
  82                         logger("Download $file failed from $host ($proto): $log");
  83                 }
  84         }
  85         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.");
  86         return 1;
  87 }
  88
  89 sub getmirrors {
  90         use File::Copy;
  91
  92         logger("Try to get a mirror list.");
  93
  94         fetchfile("lists/$Conf::version-server-list", "$Conf::mainserver");
  95         move("$Conf::cachedir/$Conf::version-server-list", "$Conf::dbdir/lists/$Conf::version-server-list");
  96 }
  97
  98 sub selectmirror {
  99         ### Check if there is a current server list and read it.
 100         #   If there is no list try to get one.
 101         my $count = 0;
 102         while (!(open(FILE, "<$Conf::dbdir/lists/$Conf::version-server-list")) && ($count lt 5)) {
 103                 $count++;
 104                 getmirrors();
 105         }
 106         if ($count == 5) {
 107                 message("Could not find or download a server list.");
 108                 exit 1;
 109         }
 110         my @lines = <FILE>;
 111         close(FILE);
 112
 113         ### Count the number of the servers in the list
 114         my $scount = 0;
 115         foreach (@lines) {
 116                 $scount++;
 117         }
 118         logger("$scount servers found in list.");
 119
 120         ### Choose a random server and test if it is online
 121         #   If the check fails try a new server.
 122         #   This will never give up.
 123         my $found = 0;
 124         my $servers = 0;
 125         while ($found == 0) {
 126                 $server = int(rand($scount) + 1);
 127                 $servers = 0;
 128                 my ($line, $proto, $path, $host);
 129                 my @templine;
 130                 foreach $line (@lines) {
 131                         $servers++;
 132                         if ($servers eq $server) {
 133                                 @templine = split(/\;/, $line);
 134                                 $proto = $templine[0];
 135                                 $host = $templine[1];
 136                                 $path = $templine[2];
 137                                 if (pinghost("$host")) {
 138                                         $found = 1;
 139                                         return ($proto, $host, $path);
 140                                 }
 141                         }
 142                 }
 143         }
 144 }
 145
 146 sub dbgetlist {
 147         ### Update the database if the file is older than one day.
 148         #   If you pass &Pakfire::dbgetlist(force) the list will be downloaded.
 149         #   Usage is always with an argument.
 150         my $force = shift;
 151         my $age;
 152
 153         use File::Copy;
 154
 155         if ( -e "$Conf::dbdir/lists/packages_list.db" ) {
 156                 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
 157                 my $time = time();
 158                 $age = $time - $stat[9];
 159         } else {
 160                 # Force an update.
 161                 $age = "86401";
 162         }
 163
 164         if (("$age" gt 86400) || ("$force" eq "force")) {
 165                 cleanup();
 166                 fetchfile("lists/packages_list.db", "");
 167                 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
 168         }
 169 }
 170
 171 sub dblist {
 172         ### This subroutine lists the packages.
 173         #   You may also pass a filter: &Pakfire::dblist(filter)
 174         #   Usage is always with two arguments.
 175         #   filter may be: all, notinstalled, installed
 176         my $filter = shift;
 177         my $forweb = shift;
 178
 179         ### Make sure that the list is not outdated.
 180         dbgetlist("noforce");
 181
 182         open(FILE, "<$Conf::dbdir/lists/packages_list.db");
 183         my @db = <FILE>;
 184         close(FILE);
 185
 186         my $line;
 187         my @templine;
 188         foreach $line (sort @db) {
 189                 @templine = split(/\;/,$line);
 190                 ### filter here...
 191                 if ("$forweb" eq "forweb") {
 192                         print "<option value=\"$templine[0]\">$templine[1]</option>\n";
 193                 } else {
 194                         print "$templine[0] $templine[1]\n";
 195                 }
 196         }
 197 }
 198
 199 sub resolvedeps {
 200         my $pak = shift;
 201
 202         getmetafile("$pak");
 203
 204         message("\n## Resolving dependencies for $pak...");
 205
 206         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 207         my @file = <FILE>;
 208         close(FILE);
 209
 210         my $line;
 211         my (@templine, @deps, @tempdeps);
 212         foreach $line (@file) {
 213                 @templine = split(/\: /,$line);
 214                 if ("$templine[0]" eq "Dependencies") {
 215                         @deps = split(/ /, $templine[1]);
 216                 }
 217         }
 218         chomp (@deps);
 219         foreach (@deps) {
 220                 if ($_) {
 221                   message("### Found dependency: $_");
 222                   push(@tempdeps,$_);
 223                 }
 224         }
 225
 226         #my @tempdeps = @deps;
 227         foreach (@tempdeps) {
 228                 if ($_) {
 229                         my @newdeps = resolvedeps("$_");
 230                         foreach(@newdeps) {
 231                                 unless (($_ eq " ") || ($_ eq "")) {
 232                                   message("### Found dependency: $_");
 233                                         push(@deps,$_);
 234                                 }
 235                         }
 236                 }
 237         }
 238         chomp (@deps);
 239         return @deps;
 240 }
 241
 242 sub cleanup {
 243         my $dir = shift;
 244         my $path;
 245
 246         if ( "$dir" eq "meta" ) {
 247                 $path = "$Conf::dbdir/meta";
 248         } elsif ( "$dir" eq "tmp" ) {
 249                 $path = "$Conf::tmpdir";
 250         }
 251         chdir("$path");
 252         opendir(DIR,".");
 253         my @files = readdir(DIR);
 254         closedir(DIR);
 255         foreach (@files) {
 256           unless (($_ eq ".") || ($_ eq "..")) {
 257                    system("rm -rf $_");
 258                 }
 259         }
 260 }
 261
 262 sub getmetafile {
 263         my $pak = shift;
 264
 265         logger("Going to download meta-$pak.");
 266
 267         unless ( -e "$Conf::dbdir/meta/meta-$pak") {
 268                 fetchfile("meta/meta-$pak", "");
 269                 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
 270         }
 271
 272         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 273         my @line = <FILE>;
 274         close(FILE);
 275
 276         open(FILE, ">$Conf::dbdir/meta/meta-$pak");
 277         foreach (@line) {
 278                 my $string = $_;
 279                 $string =~ s/\r\n/\n/g;
 280                 print FILE $string;
 281         }
 282         close(FILE);
 283         return 1;
 284 }
 285
 286 sub getsize {
 287         my $pak = shift;
 288
 289         getmetafile("$pak");
 290
 291         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 292         my @file = <FILE>;
 293         close(FILE);
 294
 295         my $line;
 296         my @templine;
 297         foreach $line (@file) {
 298                 @templine = split(/\: /,$line);
 299                 if ("$templine[0]" eq "Size") {
 300                         chomp($templine[1]);
 301                         return $templine[1];
 302                 }
 303         }
 304 }
 305
 306 sub addsizes { ## Still not working
 307         my @paks = shift;
 308
 309         my $paksize;
 310         my $totalsize = 0;
 311         foreach (@paks) {
 312                 $paksize = getsize("$_");
 313                 $totalsize = ($totalsize + $paksize) ;
 314         }
 315         return $totalsize;
 316 }
 317
 318 sub decryptpak {
 319         my $pak = shift;
 320
 321         cleanup("tmp");
 322
 323         my $file = getpak("$pak", "noforce");
 324
 325         my $return = system("gpg -d < $Conf::cachedir/$file | tar xj -C $Conf::tmpdir/");
 326
 327         logger("Decryption process returned the following: $return");
 328         if ($return == 1) { exit 1; }
 329 }
 330
 331 sub getpak {
 332         my $pak = shift;
 333         my $force = shift;
 334
 335         getmetafile("$pak");
 336
 337         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
 338         my @file = <FILE>;
 339         close(FILE);
 340
 341         my $line;
 342         my $file;
 343         my @templine;
 344         foreach $line (@file) {
 345                 @templine = split(/\: /,$line);
 346                 if ("$templine[0]" eq "File") {
 347                         chomp($templine[1]);
 348                         $file = $templine[1];
 349                 }
 350         }
 351
 352         unless ($file) {
 353                 message("No filename given in meta-file. Please phone the developers.");
 354                 exit 1;
 355         }
 356
 357         #message("\n## Downloading $file...");
 358
 359         unless ( "$force" eq "force" ) {
 360                 if ( -e "$Conf::cachedir/$file" ) {
 361                         return $file;
 362                 }
 363         }
 364
 365         fetchfile("paks/$file", "");
 366         return $file;
 367 }
 368
 369 sub setuppak {
 370         my $pak = shift;
 371
 372         message("We are going to install: $pak");
 373
 374         decryptpak("$pak");
 375
 376         my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
 377         if ($return == 0) {
 378           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 379           cleanup("tmp");
 380           copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
 381                 message("Setup completed. Congratulations!");
 382         } else {
 383                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
 384                 exit $return;
 385         }
 386         return $return;
 387 }
 388
 389 sub updatepak {
 390         my $pak = shift;
 391
 392         message("We are going to update: $pak");
 393
 394         decryptpak("$pak");
 395
 396         my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
 397         if ($return == 0) {
 398           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
 399           cleanup("tmp");
 400                 message("Update completed. Congratulations!");
 401         } else {
 402                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
 403                 exit $return;
 404         }
 405         return $return;
 406 }
 407
 408 sub removepak {
 409         my $pak = shift;
 410
 411         message("We are going to uninstall: $pak");
 412
 413         decryptpak("$pak");
 414
 415         my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
 416         if ($return == 0) {
 417           open(FILE, "<$Conf::dbdir/rootfiles/$pak");
 418                 my @file = <FILE>;
 419                 close(FILE);
 420                 foreach (@file) {
 421                   my $line = $_;
 422                   chomp($line);
 423                         system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
 424                         system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
 425                 }
 426           unlink("$Conf::dbdir/rootfiles/$pak");
 427           cleanup("tmp");
 428                 message("Uninstall completed. Congratulations!");
 429         } else {
 430                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
 431                 exit $return;
 432         }
 433         return $return;
 434 }
 435
 436 sub beautifysize {
 437         my $size = shift;
 438         $size = $size / 1024;
 439         my $unit;
 440
 441         if ($size > 1023) {
 442           $size = ($size / 1024);
 443           $unit = "MB";
 444         } else {
 445           $unit = "KB";
 446         }
 447         $size = sprintf("%.2f" , $size);
 448         my $string = "$size $unit";
 449         return $string;
 450 }
 451
 452 sub makeuuid {
 453         unless ( -e "$Conf::dbdir/uuid" ) {
 454                 message("Creating a random key...");
 455                 open(FILE, "</proc/sys/kernel/random/uuid");
 456                 my @line = <FILE>;
 457                 close(FILE);
 458
 459                 open(FILE, ">$Conf::dbdir/uuid");
 460                 foreach (@line) {
 461                         print FILE $_;
 462                 }
 463                 close(FILE);
 464         }
 465 }
 466
 467 sub senduuid {
 468         unless("$Conf::uuid") {
 469                 $Conf::uuid = `cat $Conf::dbdir/uuid`;
 470         }
 471         logger("Sending my uuid: $Conf::uuid");
 472         fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
 473         system("rm -f $Conf::cachedir/counter* 2>/dev/null");
 474 }
 475
 476 1;