Unser Paketmanager...
[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;
56 $ua->agent('Pakfire/2.1');
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];
146 if ((pinghost("$host")) && testhost("$host") ) {
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
315sub addsizes {
316 my @paks = shift;
317
318 my @sizes;
319 foreach (@paks) {
320 my $paksize = getsize("$_");
321 push(@sizes, $paksize);
322 }
323
324 my $totalsize = 0;
325 foreach (@sizes) {
326 $totalsize += $_;
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");
341 if ($return == 1) { exit 1; }
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
370 message("\n## Downloading $file...");
371
372 unless ( "$force" eq "force" ) {
373 if ( -e "$Conf::cachedir/$file" ) {
374 message("$file is already there. Skipping download.");
375 return $file;
376 }
377 }
378
379 fetchfile("paks/$file", "");
380 return $file;
381}
382
383sub setuppak {
384 my $pak = shift;
385
386 message("We are going to install: $pak");
387
388 decryptpak("$pak");
389
390 my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
391 if ($return == 0) {
392 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
393 cleanup("tmp");
394 message("Setup completed. Congratulations!");
395 } else {
396 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
397 exit $return;
398 }
399
400 exit $return;
401}
402
403sub updatepak {
404 my $pak = shift;
405
406 message("We are going to update: $pak");
407
408 decryptpak("$pak");
409
410 my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
411 if ($return == 0) {
412 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
413 cleanup("tmp");
414 message("Update completed. Congratulations!");
415 } else {
416 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
417 exit $return;
418 }
419
420 exit $return;
421}
422
423sub removepak {
424 my $pak = shift;
425
426 message("We are going to uninstall: $pak");
427
428 decryptpak("$pak");
429
430 my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
431 if ($return == 0) {
432 open(FILE, "<$Conf::dbdir/rootfiles/$pak");
433 my @file = <FILE>;
434 close(FILE);
435 foreach (@file) {
436 my $line = $_;
437 chomp($line);
438 system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
439 system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
440 }
441 unlink("$Conf::dbdir/rootfiles/$pak");
442 cleanup("tmp");
443 message("Uninstall completed. Congratulations!");
444 } else {
445 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
446 exit $return;
447 }
448
449 exit $return;
450}
451
452sub beautifysize {
453 my $size = shift;
454
455 if ($size > 1023) {
456 my $newsize = $size / 1024;
457 return "$newsize MB";
458 } else {
459 return "$size KB";
460 }
461}
462
463
4641;