Samba-Update auf neues Patchlevel. Jaja, die Sicherheitsluecken oder sowas...
[ipfire-2.x.git] / src / pakfire / lib / functions.pl
CommitLineData
1bd42c89
MT
1#!/usr/bin/perl -w
2
3require "/opt/pakfire/etc/pakfire.conf";
4b122800 4require "/var/ipfire/general-functions.pl";
1bd42c89
MT
5
6use File::Basename;
7use File::Copy;
8use LWP::UserAgent;
4d504812 9use HTTP::Response;
1bd42c89
MT
10use Net::Ping;
11
12package Pakfire;
13
4b122800
MT
14my %pakfiresettings = ();
15&General::readhash("${General::swroot}/pakfire/settings", \%pakfiresettings);
16
1bd42c89
MT
17sub message {
18 my $message = shift;
19 print "$message\n";
20 logger("$message");
21}
22
23sub logger {
24 my $log = shift;
25 system("logger -t pakfire \"$log\"");
26}
27
5b2a12ff
MT
28sub 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
1bd42c89
MT
36sub 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
50sub fetchfile {
4d504812
MT
51 my $getfile = shift;
52 my $gethost = shift;
53 my (@server, $host, $proto, $file, $allok, $i);
1bd42c89
MT
54
55 use File::Basename;
4d504812 56 $bfile = basename("$getfile");
1bd42c89 57
4d504812
MT
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";
1bd42c89 67 } else {
4d504812 68 $host = $gethost;
afabe9f7 69 $file = $getfile;
1bd42c89 70 }
4d504812
MT
71
72 $proto = "HTTP" unless $proto;
73
74 logger("Trying to get $file from $host ($proto).");
1bd42c89 75
4d504812
MT
76 my $ua = LWP::UserAgent->new;
77 $ua->agent("Pakfire/$Conf::version");
afabe9f7 78 $ua->timeout(5);
4b122800
MT
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 }
4d504812
MT
91
92 my $response = $ua->get("http://$host/$file");
93
4b122800
MT
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
4d504812 103 if ($response->is_success) {
4d504812
MT
104 if (open(FILE, ">$Conf::cachedir/$bfile")) {
105 print FILE $response->content;
106 close(FILE);
4b122800 107 logger("Download successfully done from $host (file: $file).");
4d504812
MT
108 $allok = 1;
109 return 0;
110 } else {
111 logger("Could not open $Conf::cachedir/$bfile for writing.");
112 }
113 } else {
4d504812
MT
114 logger("Download $file failed from $host ($proto): $log");
115 }
1bd42c89 116 }
4d504812
MT
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;
1bd42c89
MT
119}
120
121sub 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
130sub 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];
a08c3a2e 169 if (pinghost("$host")) {
1bd42c89
MT
170 $found = 1;
171 return ($proto, $host, $path);
172 }
173 }
174 }
4d504812 175 }
1bd42c89
MT
176}
177
178sub 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")) {
5b2a12ff 197 #cleanup();
1bd42c89
MT
198 fetchfile("lists/packages_list.db", "");
199 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
200 }
201}
202
203sub 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;
4b122800
MT
210 my @meta;
211 my $file;
212 my $line;
213 my $prog;
214 my ($name, $version, $release);
215 my @templine;
1bd42c89
MT
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);
4b122800
MT
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 }
5b2a12ff 257 }
4b122800
MT
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 }
1bd42c89
MT
273 }
274 }
275}
276
277sub 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
320sub 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
340sub 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
364sub 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 }
4b122800 382 return 0;
1bd42c89
MT
383}
384
385sub decryptpak {
386 my $pak = shift;
387
388 cleanup("tmp");
389
390 my $file = getpak("$pak", "noforce");
391
cde0e116 392 my $return = system("cd $Conf::tmpdir/ && gpg -d < $Conf::cachedir/$file | cpio -i >/dev/null 2>&1");
1bd42c89
MT
393
394 logger("Decryption process returned the following: $return");
cde0e116 395 if ($return != 0) { exit 1; }
1bd42c89
MT
396}
397
398sub 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
1bd42c89
MT
424 unless ( "$force" eq "force" ) {
425 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
426 return $file;
427 }
428 }
429
430 fetchfile("paks/$file", "");
431 return $file;
432}
433
434sub 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");
cde0e116 442 $return %= 255;
1bd42c89
MT
443 if ($return == 0) {
444 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
445 cleanup("tmp");
4d504812 446 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
1bd42c89
MT
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 }
a08c3a2e 452 return $return;
1bd42c89
MT
453}
454
455sub 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 }
8e58bd37 471 return $return;
1bd42c89
MT
472}
473
474sub 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 }
8e58bd37 499 return $return;
1bd42c89
MT
500}
501
502sub beautifysize {
503 my $size = shift;
a08c3a2e
MT
504 $size = $size / 1024;
505 my $unit;
1bd42c89
MT
506
507 if ($size > 1023) {
a08c3a2e
MT
508 $size = ($size / 1024);
509 $unit = "MB";
1bd42c89 510 } else {
a08c3a2e 511 $unit = "KB";
1bd42c89 512 }
a08c3a2e
MT
513 $size = sprintf("%.2f" , $size);
514 my $string = "$size $unit";
515 return $string;
1bd42c89
MT
516}
517
8e58bd37
MT
518sub makeuuid {
519 unless ( -e "$Conf::dbdir/uuid" ) {
8e58bd37
MT
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
532sub senduuid {
4b122800
MT
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");
8e58bd37 540 }
8e58bd37 541}
1bd42c89 542
5b2a12ff
MT
543sub 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
cde0e116
MT
559sub 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
1bd42c89 5701;