Korrektur zum speichern der 30-udev Datei.
[people/pmueller/ipfire-2.x.git] / src / pakfire / lib / functions.pl
CommitLineData
1bd42c89
MT
1#!/usr/bin/perl -w
2
3require "/opt/pakfire/etc/pakfire.conf";
4
5use File::Basename;
6use File::Copy;
7use LWP::UserAgent;
4d504812 8use HTTP::Response;
1bd42c89
MT
9use Net::Ping;
10
11package Pakfire;
12
13sub message {
14 my $message = shift;
15 print "$message\n";
16 logger("$message");
17}
18
19sub logger {
20 my $log = shift;
21 system("logger -t pakfire \"$log\"");
22}
23
5b2a12ff
MT
24sub 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
1bd42c89
MT
32sub 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
46sub fetchfile {
4d504812
MT
47 my $getfile = shift;
48 my $gethost = shift;
49 my (@server, $host, $proto, $file, $allok, $i);
1bd42c89
MT
50
51 use File::Basename;
4d504812 52 $bfile = basename("$getfile");
1bd42c89 53
4d504812
MT
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";
1bd42c89 63 } else {
4d504812 64 $host = $gethost;
afabe9f7 65 $file = $getfile;
1bd42c89 66 }
4d504812
MT
67
68 $proto = "HTTP" unless $proto;
69
70 logger("Trying to get $file from $host ($proto).");
1bd42c89 71
4d504812
MT
72 my $ua = LWP::UserAgent->new;
73 $ua->agent("Pakfire/$Conf::version");
afabe9f7 74 $ua->timeout(5);
4d504812
MT
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 }
1bd42c89 93 }
4d504812
MT
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;
1bd42c89
MT
96}
97
98sub 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
107sub 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];
a08c3a2e 146 if (pinghost("$host")) {
1bd42c89
MT
147 $found = 1;
148 return ($proto, $host, $path);
149 }
150 }
151 }
4d504812 152 }
1bd42c89
MT
153}
154
155sub 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")) {
5b2a12ff 174 #cleanup();
1bd42c89
MT
175 fetchfile("lists/packages_list.db", "");
176 move("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
177 }
178}
179
180sub 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);
5b2a12ff
MT
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 }
1bd42c89 204 if ("$forweb" eq "forweb") {
afabe9f7 205 print "<option value=\"$templine[0]\">$templine[0]-$templine[1]-$templine[2]</option>\n";
1bd42c89 206 } else {
afabe9f7 207 print "Name: $templine[0]\nVersion: $templine[1]\nRelease: $templine[2]\n\n";
1bd42c89
MT
208 }
209 }
210}
211
212sub 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
255sub 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
275sub 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
299sub 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
a08c3a2e 319sub addsizes { ## Still not working
1bd42c89
MT
320 my @paks = shift;
321
a08c3a2e 322 my $paksize;
1bd42c89 323 my $totalsize = 0;
a08c3a2e
MT
324 foreach (@paks) {
325 $paksize = getsize("$_");
326 $totalsize = ($totalsize + $paksize) ;
1bd42c89
MT
327 }
328 return $totalsize;
329}
330
331sub decryptpak {
332 my $pak = shift;
333
334 cleanup("tmp");
335
336 my $file = getpak("$pak", "noforce");
337
338 my $return = system("gpg -d < $Conf::cachedir/$file | tar xj -C $Conf::tmpdir/");
339
340 logger("Decryption process returned the following: $return");
afabe9f7 341 if ($return != 1) { exit 1; }
1bd42c89
MT
342}
343
344sub 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
1bd42c89
MT
370 unless ( "$force" eq "force" ) {
371 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
372 return $file;
373 }
374 }
375
376 fetchfile("paks/$file", "");
377 return $file;
378}
379
380sub 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 if ($return == 0) {
389 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
390 cleanup("tmp");
4d504812 391 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
1bd42c89
MT
392 message("Setup completed. Congratulations!");
393 } else {
394 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
395 exit $return;
396 }
a08c3a2e 397 return $return;
1bd42c89
MT
398}
399
400sub updatepak {
401 my $pak = shift;
402
403 message("We are going to update: $pak");
404
405 decryptpak("$pak");
406
407 my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
408 if ($return == 0) {
409 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
410 cleanup("tmp");
411 message("Update completed. Congratulations!");
412 } else {
413 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
414 exit $return;
415 }
8e58bd37 416 return $return;
1bd42c89
MT
417}
418
419sub removepak {
420 my $pak = shift;
421
422 message("We are going to uninstall: $pak");
423
424 decryptpak("$pak");
425
426 my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
427 if ($return == 0) {
428 open(FILE, "<$Conf::dbdir/rootfiles/$pak");
429 my @file = <FILE>;
430 close(FILE);
431 foreach (@file) {
432 my $line = $_;
433 chomp($line);
434 system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
435 system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
436 }
437 unlink("$Conf::dbdir/rootfiles/$pak");
438 cleanup("tmp");
439 message("Uninstall completed. Congratulations!");
440 } else {
441 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
442 exit $return;
443 }
8e58bd37 444 return $return;
1bd42c89
MT
445}
446
447sub beautifysize {
448 my $size = shift;
a08c3a2e
MT
449 $size = $size / 1024;
450 my $unit;
1bd42c89
MT
451
452 if ($size > 1023) {
a08c3a2e
MT
453 $size = ($size / 1024);
454 $unit = "MB";
1bd42c89 455 } else {
a08c3a2e 456 $unit = "KB";
1bd42c89 457 }
a08c3a2e
MT
458 $size = sprintf("%.2f" , $size);
459 my $string = "$size $unit";
460 return $string;
1bd42c89
MT
461}
462
8e58bd37
MT
463sub makeuuid {
464 unless ( -e "$Conf::dbdir/uuid" ) {
8e58bd37
MT
465 open(FILE, "</proc/sys/kernel/random/uuid");
466 my @line = <FILE>;
467 close(FILE);
468
469 open(FILE, ">$Conf::dbdir/uuid");
470 foreach (@line) {
471 print FILE $_;
472 }
473 close(FILE);
474 }
475}
476
477sub senduuid {
478 unless("$Conf::uuid") {
479 $Conf::uuid = `cat $Conf::dbdir/uuid`;
480 }
481 logger("Sending my uuid: $Conf::uuid");
482 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
4cb74dce 483 system("rm -f $Conf::cachedir/counter* 2>/dev/null");
8e58bd37 484}
1bd42c89 485
5b2a12ff
MT
486sub lock {
487 my $status = shift;
488 if ("$status" eq "on") {
489 system("touch /opt/pakfire/pakfire.lock");
490 system("chmod 777 /opt/pakfire/pakfire.lock");
491 logger("Created lock");
492 } else {
493 if (system("rm -f /opt/pakfire/pakfire.lock >/dev/null 2>&1")) {
494 logger("Successfully removed lock.");
495 } else {
496 logger("Couldn't remove lock.");
497 }
498 }
499 return 0;
500}
501
1bd42c89 5021;