1 #!/usr/bin/perl
3 use strict;
4 use File::Path;
5 use File::Basename;
7 # Check for parameters
8 if ($ARGV[0] eq ""){
9 die ("Usage: parse-pkg <config-file>\n");
10 }
12 # Generate cache
13 gen_cache($ARGV[0]);
14 exit 0;
16 #-----------------------------------------------------------------------------
18 sub gen_cache
19 {
20 my ($conffile)= @_;
21 my $line;
23 print "Generating GOsa package cache - this may take some time\n";
24 open(CONFIG, "<$conffile") or die("Failed to open '$conffile' - aborted\n");
26 # Read lines
27 while ($line = <CONFIG>){
28 # Unify
29 chop($line);
30 $line =~ s/^\s+//;
31 $line =~ s/^\s+/ /;
33 # Strip comments
34 $line =~ s/#.*$//g;
36 # Skip empty lines
37 if ($line =~ /^\s*$/){
38 next;
39 }
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(.*)$/);
47 my $section;
48 foreach $section (split(" ", $sections)){
49 parse_package_info ("$baseurl", "$dist", "$section");
50 }
51 }
52 }
54 close (CONFIG);
55 }
57 #-----------------------------------------------------------------------------
59 sub parse_package_info
60 {
61 my ($baseurl, $dist, $section)= @_;
62 my ($package, $server);
64 foreach $package ("Packages.gz"){
65 print ("* trying to retrieve $baseurl/dists/$dist/$section/binary-i386/$package\n");
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 }
74 #-----------------------------------------------------------------------------
76 sub get_package
77 {
78 my ($url, $dest)= @_;
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'");
85 return 0;
86 }
88 #-----------------------------------------------------------------------------
90 sub parse_package
91 {
92 my ($path)= @_;
93 my ($name, $desc, $vers, $sect, $line);
95 my $tpath= dirname($path);
96 -d "$tpath" || mkpath "$tpath";
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");
101 # Read lines
102 while ($line = <PACKAGES>){
103 # Unify
104 chop($line);
106 # Use empty lines as a trigger
107 if ($line =~ /^\s*$/){
108 print OUT "$name|$vers|$sect|$desc\n";
109 next;
110 }
112 # Trigger for package name
113 if ($line =~ /^Package:\s/){
114 ($name)= ($line =~ /^Package: (.*)$/);
115 next;
116 }
118 # Trigger for version
119 if ($line =~ /^Version:\s/){
120 ($vers)= ($line =~ /^Version: (.*)$/);
121 next;
122 }
124 # Trigger for description
125 if ($line =~ /^Description:\s/){
126 ($desc)= ($line =~ /^Description: (.*)$/);
127 next;
128 }
130 # Trigger for description
131 if ($line =~ /^Section:\s/){
132 ($sect)= ($line =~ /^Section: (.*)$/);
133 next;
134 }
135 }
137 close (OUT);
138 close (PACKAGES);
139 }