]> git.ipfire.org Git - ipfire-2.x.git/blame - src/pakfire/lib/functions.pl
Die Abhaengigkeitspakete vom Samba erstellt.
[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;
a08c3a2e 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 }
394
a08c3a2e 395 return $return;
1bd42c89
MT
396}
397
398sub updatepak {
399 my $pak = shift;
400
401 message("We are going to update: $pak");
402
403 decryptpak("$pak");
404
405 my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
406 if ($return == 0) {
407 move("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
408 cleanup("tmp");
409 message("Update completed. Congratulations!");
410 } else {
411 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
412 exit $return;
413 }
414
415 exit $return;
416}
417
418sub removepak {
419 my $pak = shift;
420
421 message("We are going to uninstall: $pak");
422
423 decryptpak("$pak");
424
425 my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
426 if ($return == 0) {
427 open(FILE, "<$Conf::dbdir/rootfiles/$pak");
428 my @file = <FILE>;
429 close(FILE);
430 foreach (@file) {
431 my $line = $_;
432 chomp($line);
433 system("echo \"Removing: $line\" >> $Conf::logdir/uninstall-$pak.log 2>&1");
434 system("cd / && rm -rf $line >> $Conf::logdir/uninstall-$pak.log 2>&1");
435 }
436 unlink("$Conf::dbdir/rootfiles/$pak");
437 cleanup("tmp");
438 message("Uninstall completed. Congratulations!");
439 } else {
440 message("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
441 exit $return;
442 }
443
444 exit $return;
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
463
4641;