]> git.ipfire.org Git - people/pmueller/ipfire-2.x.git/blame - src/pakfire/lib/functions.pl
IPSecctrl fuer vpnwatch angepasst
[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
24sub 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
38sub fetchfile {
4d504812
MT
39 my $getfile = shift;
40 my $gethost = shift;
41 my (@server, $host, $proto, $file, $allok, $i);
1bd42c89
MT
42
43 use File::Basename;
4d504812 44 $bfile = basename("$getfile");
1bd42c89 45
4d504812
MT
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";
1bd42c89 55 } else {
4d504812 56 $host = $gethost;
1bd42c89 57 }
4d504812
MT
58
59 $proto = "HTTP" unless $proto;
60
61 logger("Trying to get $file from $host ($proto).");
1bd42c89 62
4d504812
MT
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 }
1bd42c89 84 }
4d504812
MT
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;
1bd42c89
MT
87}
88
89sub 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
98sub 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];
a08c3a2e 137 if (pinghost("$host")) {
1bd42c89
MT
138 $found = 1;
139 return ($proto, $host, $path);
140 }
141 }
142 }
4d504812 143 }
1bd42c89
MT
144}
145
146sub 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
171sub 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
199sub 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
242sub 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
262sub 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
286sub 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
a08c3a2e 306sub addsizes { ## Still not working
1bd42c89
MT
307 my @paks = shift;
308
a08c3a2e 309 my $paksize;
1bd42c89 310 my $totalsize = 0;
a08c3a2e
MT
311 foreach (@paks) {
312 $paksize = getsize("$_");
313 $totalsize = ($totalsize + $paksize) ;
1bd42c89
MT
314 }
315 return $totalsize;
316}
317
318sub 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
331sub 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
a08c3a2e 357 #message("\n## Downloading $file...");
1bd42c89
MT
358
359 unless ( "$force" eq "force" ) {
360 if ( -e "$Conf::cachedir/$file" ) {
1bd42c89
MT
361 return $file;
362 }
363 }
364
365 fetchfile("paks/$file", "");
366 return $file;
367}
368
369sub 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");
4d504812 380 copy("$Conf::dbdir/meta/meta-$pak","$Conf::dbdir/installed/");
1bd42c89
MT
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 }
a08c3a2e 386 return $return;
1bd42c89
MT
387}
388
389sub 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 }
8e58bd37 405 return $return;
1bd42c89
MT
406}
407
408sub 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 }
8e58bd37 433 return $return;
1bd42c89
MT
434}
435
436sub beautifysize {
437 my $size = shift;
a08c3a2e
MT
438 $size = $size / 1024;
439 my $unit;
1bd42c89
MT
440
441 if ($size > 1023) {
a08c3a2e
MT
442 $size = ($size / 1024);
443 $unit = "MB";
1bd42c89 444 } else {
a08c3a2e 445 $unit = "KB";
1bd42c89 446 }
a08c3a2e
MT
447 $size = sprintf("%.2f" , $size);
448 my $string = "$size $unit";
449 return $string;
1bd42c89
MT
450}
451
8e58bd37
MT
452sub 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
467sub 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");
4cb74dce 473 system("rm -f $Conf::cachedir/counter* 2>/dev/null");
8e58bd37 474}
1bd42c89
MT
475
4761;