]>
git.ipfire.org Git - people/pmueller/ipfire-2.x.git/blob - src/pakfire/lib/functions.pl
3 require "/opt/pakfire/etc/pakfire.conf";
20 system("logger -t pakfire \"$log\"");
26 $p = Net
::Ping
->new();
27 if ($p->ping($host)) {
28 logger
("$host is alive.");
31 logger
("$host is dead.");
45 @server = selectmirror
();
48 $file = "$server[2]/$file";
51 logger
("Trying to get $file from $host ($proto).");
53 $bfile = basename
("$file");
55 my $ua = LWP
::UserAgent
->new;
56 $ua->agent('Pakfire/$Conf::version');
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;
66 message
("Could not open $Conf::cachedir/$bfile for writing.");
68 logger
("$host sends file: $file.");
72 my $log = $response->status_line;
81 my $ua = LWP
::UserAgent
->new;
82 $ua->agent('Pakfire/2.1');
86 my $response = $ua->get("http://$host/dummy");
87 if ($response->is_success) {
88 logger
("$host answers my request.");
92 my $log = $response->status_line;
93 logger
("Server does not work properly: $log");
101 logger
("Try to get a mirror list.");
103 fetchfile
("lists/$Conf::version-server-list", "$Conf::mainserver");
104 move
("$Conf::cachedir/$Conf::version-server-list", "$Conf::dbdir/lists/$Conf::version-server-list");
108 ### Check if there is a current server list and read it.
109 # If there is no list try to get one.
111 while (!(open(FILE
, "<$Conf::dbdir/lists/$Conf::version-server-list")) && ($count lt 5)) {
116 message
("Could not find or download a server list.");
122 ### Count the number of the servers in the list
127 logger
("$scount servers found in list.");
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.
134 while ($found == 0) {
135 $server = int(rand($scount) + 1);
137 my ($line, $proto, $path, $host);
139 foreach $line (@lines) {
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")) {
148 return ($proto, $host, $path);
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.
164 if ( -e
"$Conf::dbdir/lists/packages_list.db" ) {
165 my @stat = stat("$Conf::dbdir/lists/packages_list.db");
167 $age = $time - $stat[9];
173 if (("$age" gt 86400) || ("$force" eq "force")) {
175 fetchfile
("lists/packages_list.db", "");
176 move
("$Conf::cachedir/packages_list.db", "$Conf::dbdir/lists/packages_list.db");
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
188 ### Make sure that the list is not outdated.
189 dbgetlist
("noforce");
191 open(FILE
, "<$Conf::dbdir/lists/packages_list.db");
197 foreach $line (sort @db) {
198 @templine = split(/\;/,$line);
200 if ("$forweb" eq "forweb") {
201 print "<option value=\"$templine[0]\">$templine[1]</option>\n";
203 print "$templine[0] $templine[1]\n";
213 message
("\n## Resolving dependencies for $pak...");
215 open(FILE
, "<$Conf::dbdir/meta/meta-$pak");
220 my (@templine, @deps, @tempdeps);
221 foreach $line (@file) {
222 @templine = split(/\: /,$line);
223 if ("$templine[0]" eq "Dependencies") {
224 @deps = split(/ /, $templine[1]);
230 message
("### Found dependency: $_");
235 #my @tempdeps = @deps;
236 foreach (@tempdeps) {
238 my @newdeps = resolvedeps
("$_");
240 unless (($_ eq " ") || ($_ eq "")) {
241 message
("### Found dependency: $_");
255 if ( "$dir" eq "meta" ) {
256 $path = "$Conf::dbdir/meta";
257 } elsif ( "$dir" eq "tmp" ) {
258 $path = "$Conf::tmpdir";
262 my @files = readdir(DIR
);
265 unless (($_ eq ".") || ($_ eq "..")) {
274 logger
("Going to download meta-$pak.");
276 unless ( -e
"$Conf::dbdir/meta/meta-$pak") {
277 fetchfile
("meta/meta-$pak", "");
278 move
("$Conf::cachedir/meta-$pak", "$Conf::dbdir/meta/meta-$pak");
281 open(FILE
, "<$Conf::dbdir/meta/meta-$pak");
285 open(FILE
, ">$Conf::dbdir/meta/meta-$pak");
288 $string =~ s/\r\n/\n/g;
300 open(FILE
, "<$Conf::dbdir/meta/meta-$pak");
306 foreach $line (@file) {
307 @templine = split(/\: /,$line);
308 if ("$templine[0]" eq "Size") {
315 sub addsizes
{ ## Still not working
321 $paksize = getsize
("$_");
322 $totalsize = ($totalsize + $paksize) ;
332 my $file = getpak
("$pak", "noforce");
334 my $return = system("gpg -d < $Conf::cachedir/$file | tar xj -C $Conf::tmpdir/");
336 logger
("Decryption process returned the following: $return");
337 if ($return == 1) { exit 1; }
346 open(FILE
, "<$Conf::dbdir/meta/meta-$pak");
353 foreach $line (@file) {
354 @templine = split(/\: /,$line);
355 if ("$templine[0]" eq "File") {
357 $file = $templine[1];
362 message
("No filename given in meta-file. Please phone the developers.");
366 #message("\n## Downloading $file...");
368 unless ( "$force" eq "force" ) {
369 if ( -e
"$Conf::cachedir/$file" ) {
374 fetchfile
("paks/$file", "");
381 message
("We are going to install: $pak");
385 my $return = system("cd $Conf::tmpdir && ./install.sh >> $Conf::logdir/install-$pak.log 2>&1");
387 move
("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
389 message
("Setup completed. Congratulations!");
391 message
("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
401 message
("We are going to update: $pak");
405 my $return = system("cd $Conf::tmpdir && ./update.sh >> $Conf::logdir/update-$pak.log 2>&1");
407 move
("$Conf::tmpdir/ROOTFILES", "$Conf::dbdir/rootfiles/$pak");
409 message
("Update completed. Congratulations!");
411 message
("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
421 message
("We are going to uninstall: $pak");
425 my $return = system("cd $Conf::tmpdir && ./uninstall.sh >> $Conf::logdir/uninstall-$pak.log 2>&1");
427 open(FILE
, "<$Conf::dbdir/rootfiles/$pak");
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");
436 unlink("$Conf::dbdir/rootfiles/$pak");
438 message
("Uninstall completed. Congratulations!");
440 message
("Setup returned: $return. Sorry. Please search our forum to find a solution for this problem.");
449 $size = $size / 1024;
453 $size = ($size / 1024);
458 $size = sprintf("%.2f" , $size);
459 my $string = "$size $unit";