Samba-Update auf neues Patchlevel. Jaja, die Sicherheitsluecken oder sowas...
[ipfire-2.x.git] / 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 a pak.");
32   &Pakfire::message("               <list> - Outputs a short list with all available paks.");
33   exit 1;
34 }
35
36 sub pinghost {
37         my $host = shift;
38         
39         $p = Net::Ping->new();
40   if ($p->ping($host)) {
41         logger("$host is alive.");
42         return 1;
43   } else {
44                 logger("$host is dead.");
45                 return 0;
46         }
47   $p->close();
48 }
49
50 sub fetchfile {
51         my $getfile = shift;
52         my $gethost = shift;
53         my (@server, $host, $proto, $file, $allok, $i);
54         
55         use File::Basename;
56         $bfile = basename("$getfile");
57
58         $i = 0; 
59         while (($allok == 0) && $i < 5) {
60                 $i++;
61                 
62                 if ("$gethost" eq "") {
63                         @server = selectmirror();
64                         $proto = $server[0];
65                         $host = $server[1];
66                         $file = "$server[2]/$getfile";
67                 } else {
68                         $host = $gethost;
69                         $file = $getfile;
70                 }
71                 
72                 $proto = "HTTP" unless $proto;
73                 
74                 logger("Trying to get $file from $host ($proto).");
75
76                 my $ua = LWP::UserAgent->new;
77                 $ua->agent("Pakfire/$Conf::version");
78                 $ua->timeout(5);
79                 
80                 my %proxysettings=();
81                 &General::readhash("${General::swroot}/proxy/advanced/settings", \%proxysettings);
82
83                 if ($_=$proxysettings{'UPSTREAM_PROXY'}) {
84                         my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);
85                         if ($proxysettings{'UPSTREAM_USER'}) {
86                                 $ua->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$peer:$peerport/");
87                         } else {
88                                 $ua->proxy("http","http://$peer:$peerport/");
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 $file;
212         my $line;
213         my $prog;
214         my ($name, $version, $release);
215         my @templine;
216         
217         ### Make sure that the list is not outdated. 
218         dbgetlist("noforce");
219
220         open(FILE, "<$Conf::dbdir/lists/packages_list.db");
221         my @db = <FILE>;
222         close(FILE);
223
224         if ("$filter" eq "upgrade") {
225                 opendir(DIR,"$Conf::dbdir/meta");
226                 my @files = readdir(DIR);
227                 closedir(DIR);
228                 foreach $file (@files) {
229                         next if ( $file eq "." );
230                         next if ( $file eq ".." );
231                         open(FILE, "<$Conf::dbdir/meta/$file");
232                         @meta = <FILE>;
233                         close(FILE);
234                         foreach $line (@meta) {
235                                 @templine = split(/\: /,$line);
236                                 if ("$templine[0]" eq "Name") {
237                                         $name = $templine[1];
238                                         chomp($name);
239                                 } elsif ("$templine[0]" eq "ProgVersion") {
240                                         $version = $templine[1];
241                                         chomp($version);
242                                 } elsif ("$templine[0]" eq "Release") {
243                                         $release = $templine[1];
244                                         chomp($release);
245                                 }
246                         }
247                         foreach $prog (@db) {
248                                 @templine = split(/\;/,$prog);
249                                 if (("$name" eq "$templine[0]") && ("$release" < "$templine[2]" )) {
250                                         if ("$forweb" eq "forweb") {
251                                                 print "<option value=\"$name\">Update: $name -- Version: $version -> $templine[1] -- Release: $release -> $templine[2]</option>\n";
252                                         } else {
253                                                 print "Update: $name\nVersion: $version -> $templine[1]\nRelease: $release -> $templine[2]\n\n";
254                                         }
255                                 }
256                         }
257                 }
258         } else {
259                 my $line;
260                 my @templine;
261                 foreach $line (sort @db) {
262                         @templine = split(/\;/,$line);
263                         if ("$filter" eq "notinstalled") {
264                                 next if ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
265                         } elsif ("$filter" eq "installed") {
266                                 next unless ( -e "$Conf::dbdir/installed/meta-$templine[0]" );
267                         }
268                         if ("$forweb" eq "forweb") {
269                                 print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
270                         } else {
271                                 print "Name: $templine[0]\nProgVersion: $templine[1]\nRelease: $templine[2]\n\n";
272                         }
273                 }
274         }
275 }
276
277 sub resolvedeps {
278         my $pak = shift;
279         
280         getmetafile("$pak");
281         
282         message("\n## Resolving dependencies for $pak...");
283         
284         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
285         my @file = <FILE>;
286         close(FILE);
287         
288         my $line;
289         my (@templine, @deps, @tempdeps);
290         foreach $line (@file) {
291                 @templine = split(/\: /,$line);
292                 if ("$templine[0]" eq "Dependencies") {
293                         @deps = split(/ /, $templine[1]);
294                 }
295         }
296         chomp (@deps);
297         foreach (@deps) {
298                 if ($_) {
299                   message("### Found dependency: $_");
300                   push(@tempdeps,$_);
301                 }
302         }
303         
304         #my @tempdeps = @deps;
305         foreach (@tempdeps) {
306                 if ($_) {
307                         my @newdeps = resolvedeps("$_");
308                         foreach(@newdeps) {
309                                 unless (($_ eq " ") || ($_ eq "")) {
310                                   message("### Found dependency: $_");
311                                         push(@deps,$_);
312                                 }
313                         }
314                 }
315         }
316         chomp (@deps);
317         return @deps;
318 }
319
320 sub cleanup {
321         my $dir = shift;
322         my $path;
323         
324         if ( "$dir" eq "meta" ) {
325                 $path = "$Conf::dbdir/meta";
326         } elsif ( "$dir" eq "tmp" ) {
327                 $path = "$Conf::tmpdir";
328         }
329         chdir("$path");
330         opendir(DIR,".");
331         my @files = readdir(DIR);
332         closedir(DIR);
333         foreach (@files) {
334           unless (($_ eq ".") || ($_ eq "..")) {
335                    system("rm -rf $_");
336                 }
337         }
338 }
339
340 sub getmetafile {
341         my $pak = shift;
342         
343         logger("Going to download meta-$pak.");
344         
345         unless ( -e "$Conf::dbdir/meta/meta-$pak") {
346                 fetchfile("meta/meta-$pak", "");
347                 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
348         }
349         
350         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
351         my @line = <FILE>;
352         close(FILE);
353         
354         open(FILE, ">$Conf::dbdir/meta/meta-$pak");
355         foreach (@line) {
356                 my $string = $_;
357                 $string =~ s/\r\n/\n/g;
358                 print FILE $string;
359         }
360         close(FILE);
361         return 1;
362 }
363
364 sub getsize {
365         my $pak = shift;
366         
367         getmetafile("$pak");
368         
369         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
370         my @file = <FILE>;
371         close(FILE);
372         
373         my $line;
374         my @templine;
375         foreach $line (@file) {
376                 @templine = split(/\: /,$line);
377                 if ("$templine[0]" eq "Size") {
378                         chomp($templine[1]);
379                         return $templine[1];
380                 }
381         }
382         return 0;
383 }
384
385 sub decryptpak {
386         my $pak = shift;
387         
388         cleanup("tmp");
389         
390         my $file = getpak("$pak", "noforce");
391         
392         my $return = system("cd $Conf::tmpdir/ && gpg -d < $Conf::cachedir/$file | cpio -i >/dev/null 2>&1");
393         
394         logger("Decryption process returned the following: $return");
395         if ($return != 0) { exit 1; }
396 }
397
398 sub getpak {
399         my $pak = shift;
400         my $force = shift;
401
402         getmetafile("$pak");
403         
404         open(FILE, "<$Conf::dbdir/meta/meta-$pak");
405         my @file = <FILE>;
406         close(FILE);
407         
408         my $line;
409         my $file;
410         my @templine;
411         foreach $line (@file) {
412                 @templine = split(/\: /,$line);
413                 if ("$templine[0]" eq "File") {
414                         chomp($templine[1]);
415                         $file = $templine[1];
416                 }
417         }
418         
419         unless ($file) {
420                 message("No filename given in meta-file. Please phone the developers.");
421                 exit 1;
422         }
423         
424         unless ( "$force" eq "force" ) {
425                 if ( -e "$Conf::cachedir/$file" ) {
426                         return $file;
427                 }
428         }
429         
430         fetchfile("paks/$file", "");
431         return $file;
432 }
433
434 sub setuppak {
435         my $pak = shift;
436         
437         message("We are going to install: $pak");
438         
439         decryptpak("$pak");
440         
441         my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
442         $return %= 255;
443         if ($return == 0) {
444           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
445           cleanup("tmp");
446           copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
447                 message("Setup completed. Congratulations!");
448         } else {
449                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
450                 exit $return;
451         }
452         return $return;
453 }
454
455 sub updatepak {
456         my $pak = shift;
457
458         message("We are going to update: $pak");
459
460         decryptpak("$pak");
461
462         my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
463         if ($return == 0) {
464           move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
465           cleanup("tmp");
466                 message("Update completed. Congratulations!");
467         } else {
468                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
469                 exit $return;
470         }
471         return $return;
472 }
473
474 sub removepak {
475         my $pak = shift;
476
477         message("We are going to uninstall: $pak");
478
479         decryptpak("$pak");
480
481         my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
482         if ($return == 0) {
483           open(FILE, "<$Conf::dbdir/rootfiles/$pak");
484                 my @file = <FILE>;
485                 close(FILE);
486                 foreach (@file) {
487                   my $line = $_;
488                   chomp($line);
489                         system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
490                         system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
491                 }
492           unlink("$Conf::dbdir/rootfiles/$pak");
493           cleanup("tmp");
494                 message("Uninstall completed. Congratulations!");
495         } else {
496                 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
497                 exit $return;
498         }
499         return $return;
500 }
501
502 sub beautifysize {
503         my $size = shift;
504         $size = $size / 1024;
505         my $unit;
506         
507         if ($size > 1023) {
508           $size = ($size / 1024);
509           $unit = "MB";
510         } else {
511           $unit = "KB";
512         }
513         $size = sprintf("%.2f" , $size);
514         my $string = "$size $unit";
515         return $string;
516 }
517
518 sub makeuuid {
519         unless ( -e "$Conf::dbdir/uuid" ) {
520                 open(FILE, "</proc/sys/kernel/random/uuid");
521                 my @line = <FILE>;
522                 close(FILE);
523                 
524                 open(FILE, ">$Conf::dbdir/uuid");
525                 foreach (@line) {
526                         print FILE $_;
527                 }
528                 close(FILE);
529         }
530 }
531
532 sub senduuid {
533         if ($pakfiresettings{'UUID'} eq "on") {
534                 unless("$Conf::uuid") {
535                         $Conf::uuid = `cat $Conf::dbdir/uuid`;
536                 }
537                 logger("Sending my uuid: $Conf::uuid");
538                 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
539                 system("rm -f $Conf::cachedir/counter* 2>/dev/null");
540         }
541 }
542
543 sub lock {
544         my $status = shift;
545         if ("$status" eq "on") {
546                 system("touch /opt/pakfire/pakfire.lock");
547                 system("chmod 777 /opt/pakfire/pakfire.lock");
548                 logger("Created lock");
549         } else {
550                 if (system("rm -f /opt/pakfire/pakfire.lock >/dev/null 2>&1")) {
551                         logger("Successfully removed lock.");
552                 } else {
553                         logger("Couldn't remove lock.");
554                 }
555         }
556         return 0;
557 }
558
559 sub checkcryptodb {
560         my $myid = "64D96617"; # Our own gpg-key
561         my $trustid = "65D0FD58"; # Id of CaCert
562         my $ret = system("gpg --list-keys | grep -q $myid");
563         unless ( "$ret" eq "0" ) {
564                 message("The GnuPG isn't configured corectly. Trying now to fix this.");
565                 system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $myid");
566                 system("gpg --keyserver wwwkeys.de.pgp.net --always-trust --recv-key $trustid");
567         }
568 }
569
570 1;