Nochmal einige CGI Aenderungen
[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;
8use Net::Ping;
9
10package Pakfire;
11
12sub message {
13 my $message = shift;
14 print "$message\n";
15 logger("$message");
16}
17
18sub logger {
19 my $log = shift;
20 system("logger -t pakfire \"$log\"");
21}
22
23sub pinghost {
24 my $host = shift;
25
26 $p = Net::Ping->new();
27 if ($p->ping($host)) {
28 logger("$host is alive.");
29 return 1;
30 } else {
31 logger("$host is dead.");
32 return 0;
33 }
34 $p->close();
35}
36
37sub fetchfile {
38 my $file = shift;
39 my $host = shift;
40 my (@server, $proto);
41
42 use File::Basename;
43
44 if ("$host" eq "") {
45 @server = selectmirror();
46 $proto = $server[0];
47 $host = $server[1];
48 $file = "$server[2]/$file";
49 }
50
51 logger("Trying to get $file from $host ($proto).");
52
53 $bfile = basename("$file");
54
55 my $ua = LWP::UserAgent->new;
8e58bd37 56 $ua->agent("Pakfire/$Conf::version");
1bd42c89
MT
57 #$ua->timeout(5);
58 #$ua->env_proxy;
59
60 my $response = $ua->get("http://$host/$file");
61 if ($response->is_success) {
62 if (open(FILE, ">$Conf::cachedir/$bfile")) {
63 print FILE $response->content;
64 close(FILE);
65 } else {
66 message("Could not open $Conf::cachedir/$bfile for writing.");
67 }
68 logger("$host sends file: $file.");
69 return 1;
70 }
71 else {
72 my $log = $response->status_line;
73 logger("$log");
74 return 0;
75 }
76}
77
78sub testhost {
79 my $host = shift;
80
81 my $ua = LWP::UserAgent->new;
82 $ua->agent('Pakfire/2.1');
83 $ua->timeout(5);
84 # $ua->env_proxy;
85
86 my $response = $ua->get("http://$host/dummy");
87 if ($response->is_success) {
88 logger("$host answers my request.");
89 return 1;
90 }
91 else {
92 my $log = $response->status_line;
93 logger("Server does not work properly: $log");
94 return 0;
95 }
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 }
152 }
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")) {
174 cleanup();
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);
199 ### filter here...
200 if ("$forweb" eq "forweb") {
201 print "<option value=\"$templine[0]\">$templine[1]</option>\n";
202 } else {
203 print "$templine[0] $templine[1]\n";
204 }
205 }
206}
207
208sub resolvedeps {
209 my $pak = shift;
210
211 getmetafile("$pak");
212
213 message("\n## Resolving dependencies for $pak...");
214
215 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
216 my @file = <FILE>;
217 close(FILE);
218
219 my $line;
220 my (@templine, @deps, @tempdeps);
221 foreach $line (@file) {
222 @templine = split(/\: /,$line);
223 if ("$templine[0]" eq "Dependencies") {
224 @deps = split(/ /, $templine[1]);
225 }
226 }
227 chomp (@deps);
228 foreach (@deps) {
229 if ($_) {
230 message("### Found dependency: $_");
231 push(@tempdeps,$_);
232 }
233 }
234
235 #my @tempdeps = @deps;
236 foreach (@tempdeps) {
237 if ($_) {
238 my @newdeps = resolvedeps("$_");
239 foreach(@newdeps) {
240 unless (($_ eq " ") || ($_ eq "")) {
241 message("### Found dependency: $_");
242 push(@deps,$_);
243 }
244 }
245 }
246 }
247 chomp (@deps);
248 return @deps;
249}
250
251sub cleanup {
252 my $dir = shift;
253 my $path;
254
255 if ( "$dir" eq "meta" ) {
256 $path = "$Conf::dbdir/meta";
257 } elsif ( "$dir" eq "tmp" ) {
258 $path = "$Conf::tmpdir";
259 }
260 chdir("$path");
261 opendir(DIR,".");
262 my @files = readdir(DIR);
263 closedir(DIR);
264 foreach (@files) {
265 unless (($_ eq ".") || ($_ eq "..")) {
266 system("rm -rf $_");
267 }
268 }
269}
270
271sub getmetafile {
272 my $pak = shift;
273
274 logger("Going to download meta-$pak.");
275
276 unless ( -e "$Conf::dbdir/meta/meta-$pak") {
277 fetchfile("meta/meta-$pak", "");
278 move("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
279 }
280
281 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
282 my @line = <FILE>;
283 close(FILE);
284
285 open(FILE, ">$Conf::dbdir/meta/meta-$pak");
286 foreach (@line) {
287 my $string = $_;
288 $string =~ s/\r\n/\n/g;
289 print FILE $string;
290 }
291 close(FILE);
292 return 1;
293}
294
295sub getsize {
296 my $pak = shift;
297
298 getmetafile("$pak");
299
300 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
301 my @file = <FILE>;
302 close(FILE);
303
304 my $line;
305 my @templine;
306 foreach $line (@file) {
307 @templine = split(/\: /,$line);
308 if ("$templine[0]" eq "Size") {
309 chomp($templine[1]);
310 return $templine[1];
311 }
312 }
313}
314
a08c3a2e 315sub addsizes { ## Still not working
1bd42c89
MT
316 my @paks = shift;
317
a08c3a2e 318 my $paksize;
1bd42c89 319 my $totalsize = 0;
a08c3a2e
MT
320 foreach (@paks) {
321 $paksize = getsize("$_");
322 $totalsize = ($totalsize + $paksize) ;
1bd42c89
MT
323 }
324 return $totalsize;
325}
326
327sub decryptpak {
328 my $pak = shift;
329
330 cleanup("tmp");
331
332 my $file = getpak("$pak", "noforce");
333
334 my $return = system("gpg -d < $Conf::cachedir/$file | tar xj -C $Conf::tmpdir/");
335
336 logger("Decryption process returned the following: $return");
337 if ($return == 1) { exit 1; }
338}
339
340sub getpak {
341 my $pak = shift;
342 my $force = shift;
343
344 getmetafile("$pak");
345
346 open(FILE, "<$Conf::dbdir/meta/meta-$pak");
347 my @file = <FILE>;
348 close(FILE);
349
350 my $line;
351 my $file;
352 my @templine;
353 foreach $line (@file) {
354 @templine = split(/\: /,$line);
355 if ("$templine[0]" eq "File") {
356 chomp($templine[1]);
357 $file = $templine[1];
358 }
359 }
360
361 unless ($file) {
362 message("No filename given in meta-file. Please phone the developers.");
363 exit 1;
364 }
365
a08c3a2e 366 #message("\n## Downloading $file...");
1bd42c89
MT
367
368 unless ( "$force" eq "force" ) {
369 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
370 return $file;
371 }
372 }
373
374 fetchfile("paks/$file", "");
375 return $file;
376}
377
378sub setuppak {
379 my $pak = shift;
380
381 message("We are going to install: $pak");
382
383 decryptpak("$pak");
384
385 my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
386 if ($return == 0) {
387 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
388 cleanup("tmp");
389 message("Setup completed. Congratulations!");
390 } else {
391 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
392 exit $return;
393 }
a08c3a2e 394 return $return;
1bd42c89
MT
395}
396
397sub updatepak {
398 my $pak = shift;
399
400 message("We are going to update: $pak");
401
402 decryptpak("$pak");
403
404 my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
405 if ($return == 0) {
406 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
407 cleanup("tmp");
408 message("Update completed. Congratulations!");
409 } else {
410 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
411 exit $return;
412 }
8e58bd37 413 return $return;
1bd42c89
MT
414}
415
416sub removepak {
417 my $pak = shift;
418
419 message("We are going to uninstall: $pak");
420
421 decryptpak("$pak");
422
423 my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
424 if ($return == 0) {
425 open(FILE, "<$Conf::dbdir/rootfiles/$pak");
426 my @file = <FILE>;
427 close(FILE);
428 foreach (@file) {
429 my $line = $_;
430 chomp($line);
431 system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
432 system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
433 }
434 unlink("$Conf::dbdir/rootfiles/$pak");
435 cleanup("tmp");
436 message("Uninstall completed. Congratulations!");
437 } else {
438 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
439 exit $return;
440 }
8e58bd37 441 return $return;
1bd42c89
MT
442}
443
444sub beautifysize {
445 my $size = shift;
a08c3a2e
MT
446 $size = $size / 1024;
447 my $unit;
1bd42c89
MT
448
449 if ($size > 1023) {
a08c3a2e
MT
450 $size = ($size / 1024);
451 $unit = "MB";
1bd42c89 452 } else {
a08c3a2e 453 $unit = "KB";
1bd42c89 454 }
a08c3a2e
MT
455 $size = sprintf("%.2f" , $size);
456 my $string = "$size $unit";
457 return $string;
1bd42c89
MT
458}
459
8e58bd37
MT
460sub makeuuid {
461 unless ( -e "$Conf::dbdir/uuid" ) {
462 message("Creating a random key...");
463 open(FILE, "</proc/sys/kernel/random/uuid");
464 my @line = <FILE>;
465 close(FILE);
466
467 open(FILE, ">$Conf::dbdir/uuid");
468 foreach (@line) {
469 print FILE $_;
470 }
471 close(FILE);
472 }
473}
474
475sub senduuid {
476 unless("$Conf::uuid") {
477 $Conf::uuid = `cat $Conf::dbdir/uuid`;
478 }
479 logger("Sending my uuid: $Conf::uuid");
480 fetchfile("cgi-bin/counter?ver=$Conf::version&uuid=$Conf::uuid", "$Conf::mainserver");
4cb74dce 481 system("rm -f $Conf::cachedir/counter* 2>/dev/null");
8e58bd37 482}
1bd42c89
MT
483
4841;