contrib/fai/get-packages.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use File::Path;
   5 use File::Basename;
   6
   7 # Check for parameters
   8 if ($ARGV[0] eq ""){
   9         die ("Usage: parse-pkg <config-file>\n");
  10 }
  11
  12 # Generate cache
  13 gen_cache($ARGV[0]);
  14 exit 0;
  15
  16 #-----------------------------------------------------------------------------
  17
  18 sub gen_cache
  19 {
  20         my ($conffile)= @_;
  21         my $line;
  22
  23         print "Generating GOsa package cache - this may take some time\n";
  24         open(CONFIG, "<$conffile") or die("Failed to open '$conffile' - aborted\n");
  25
  26         # Read lines
  27         while ($line = <CONFIG>){
  28                 # Unify
  29                 chop($line);
  30                 $line =~ s/^\s+//;
  31                 $line =~ s/^\s+/ /;
  32
  33                 # Strip comments
  34                 $line =~ s/#.*$//g;
  35
  36                 # Skip empty lines
  37                 if ($line =~ /^\s*$/){
  38                         next;
  39                 }
  40
  41                 # Interpret deb line
  42                 if ($line =~ /^deb [^\s]+\s[^\s]+\s[^\s]+/){
  43                         my ($baseurl)  = ($line =~ /^deb\s([^\s]+)/);
  44                         my ($dist)     = ($line =~ /^deb\s[^\s]+\s([^\s]+)/);
  45                         my ($sections) = ($line =~ /^deb\s[^\s]+\s[^\s]+\s(.*)$/);
  46
  47                         my $section;
  48                         foreach $section (split(" ", $sections)){
  49                                 parse_package_info ("$baseurl", "$dist", "$section");
  50                         }
  51                 }
  52         }
  53
  54         close (CONFIG);
  55 }
  56
  57 #-----------------------------------------------------------------------------
  58
  59 sub parse_package_info
  60 {
  61         my ($baseurl, $dist, $section)= @_;
  62         my ($package, $server);
  63
  64         foreach $package ("Packages.gz"){
  65                 print ("* trying to retrieve $baseurl/dists/$dist/$section/binary-i386/$package\n");
  66
  67                 ($server)= ($baseurl =~ /^[^\/]+\/\/([^\/]+)\/.*$/);
  68                 get_package("$baseurl/dists/$dist/$section/binary-i386/$package", "/etc/gosa/fai/$server/$dist/$section");
  69                 parse_package("/etc/gosa/fai/$server/$dist/$section");
  70                 last;
  71         }
  72 }
  73
  74 #-----------------------------------------------------------------------------
  75
  76 sub get_package
  77 {
  78         my ($url, $dest)= @_;
  79
  80         # This is ugly, but I've no time to take a look at "how it works in perl"
  81         system("wget '$url' -O '$dest'");
  82         system("gzip -cd '$dest' > '$dest.in'");
  83         system("rm -f '$dest'");
  84
  85         return 0;
  86 }
  87
  88 #-----------------------------------------------------------------------------
  89
  90 sub parse_package
  91 {
  92         my ($path)= @_;
  93         my ($name, $desc, $vers, $sect, $line);
  94
  95         my $tpath= dirname($path);
  96         -d "$tpath" || mkpath "$tpath";
  97
  98         open(PACKAGES, "<$path.in") or die("Failed to open '$path.in' - aborted\n");
  99         open(OUT, ">$path") or die("Failed to open '$path' - aborted\n");
 100
 101         # Read lines
 102         while ($line = <PACKAGES>){
 103                 # Unify
 104                 chop($line);
 105
 106                 # Use empty lines as a trigger
 107                 if ($line =~ /^\s*$/){
 108                         print OUT "$name|$vers|$sect|$desc\n";
 109                         next;
 110                 }
 111
 112                 # Trigger for package name
 113                 if ($line =~ /^Package:\s/){
 114                         ($name)= ($line =~ /^Package: (.*)$/);
 115                         next;
 116                 }
 117
 118                 # Trigger for version
 119                 if ($line =~ /^Version:\s/){
 120                         ($vers)= ($line =~ /^Version: (.*)$/);
 121                         next;
 122                 }
 123
 124                 # Trigger for description
 125                 if ($line =~ /^Description:\s/){
 126                         ($desc)= ($line =~ /^Description: (.*)$/);
 127                         next;
 128                 }
 129
 130                 # Trigger for description
 131                 if ($line =~ /^Section:\s/){
 132                         ($sect)= ($line =~ /^Section: (.*)$/);
 133                         next;
 134                 }
 135         }
 136
 137         close (OUT);
 138         close (PACKAGES);
 139 }
 140