#! /usr/bin/perl
# -----------------------------------------------------------------------------
# Copyright (c) 2006 - 2009 - OpenSLX GmbH
#
# This program is free software distributed under the GPL version 2.
# See http://openslx.org/COPYING
#
# If you have any feedback please consult http://openslx.org/feedback and
# send your suggestions, praise, or complaints to feedback@openslx.org
#
# General information about OpenSLX can be found at http://openslx.org/
# -----------------------------------------------------------------------------
use strict;
use warnings;
use Data::Dumper;
my $abstract = q[
determineMinimumPackageSet.pl
This script is a tool for OpenSLX developers that is meant to generate a
packageset for settings.default. It can be used to generate
bootstrap-packages for example.
];
use Getopt::Long;
use Pod::Usage;
my (
$helpReq,
$verbose,
$versionReq,
$inputfile,
$outputfile,
$url,
$errorfile,
@Pkgs,
@files,
@GivenNames,
@filelisting,
@errors,
);
$errorfile="/tmp/genSettings.err";
GetOptions(
'help|?' => \$helpReq,
'verbose' => \$verbose,
'version' => \$versionReq,
'if=s' => \$inputfile,
'of=s' => \$outputfile,
'url=s' => \$url,
) or pod2usage(2);
pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq;
if ($versionReq) {
system('slxversion');
exit 1;
}
open(INPUTFILE,$inputfile) || die("Can't open input-file $inputfile!");
while (my $zeile=<INPUTFILE>){
if ($zeile ne "") {
push (@GivenNames,$zeile);
}
}
close(INPUTFILE);
print "getting filelisting:\n" if $verbose;
if (substr($url,0,3) eq "ftp") {
print "\trecognized mirror as ftp - $url\n" if $verbose;
@filelisting=_getPackageListingFtp($url);
} elsif (substr($url,0,4) eq "http") {
print "\trecognized mirror as http - $url\n" if $verbose;
@filelisting=_getPackageListingHttp($url);
} else {
die "Unable to get mirror type (ftp or http)";
}
print "\tgot file listing from $url\n" if $verbose;
print "resolving names:\n" if $verbose;
foreach my $name (@GivenNames) {
$name=~ s/^[\s\t]+//; #removes whitespaces
$name=~ s/[\n\t\r]$//; #removes new lines
my @possiblepackages = grep(/^\Q$name\E*/i,@filelisting);
my $res;
if ($possiblepackages[0]) {
$res = $possiblepackages[0];
} else {
push (@errors,$name);
}
print "\t$name->$res\n" if $verbose;
push (@Pkgs,$res) if $res;
}
open (OUTPUTFILE,">>$outputfile") || die("Can't open output-file $outputfile!");
foreach my $package (@Pkgs) {
print OUTPUTFILE "$package\n";
}
close (OUTPUTFILE);
open (ERRORFILE,">>$errorfile") || die("Can't open output-file $errorfile!");
foreach my $error (@errors) {
print ERRORFILE "$error\n";
}
close (ERRORFILE);
print "\n";
if ($verbose) {
print "THE PACKAGE LIST:\n";
print(('=' x 40)."\n");
print join("\n", sort @Pkgs)."\n";
}
exit;
sub _getPackageListingFtp {
my $url = shift;
use Net::FTP;
use URI;
require URI::_generic;
my $urlObject = URI->new($url);
my $path = shift;
my $ftp = Net::FTP->new($urlObject->host( ), Timeout => 240)
or die _tr("Unable to connect to FTP-Server");
$ftp->login("anonymous", "mailaddress@");
$ftp->cwd($urlObject->path( ));
return $ftp->ls();
}
sub _getPackageListingHttp {
my $url = shift;
use URI;
use URI::http;
use URI::_foreign;
use HTTP::Request;
use LWP::UserAgent;
use LWP::Protocol::http;
my @filelisting;
my $ua = LWP::UserAgent->new;
$ua->agent("Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8) Gecko/20051111 Firefox/1.5");
my $req;
$req = HTTP::Request->new(GET => $url);
$req->header('Accept' => 'text/html');
# send request
my $res = $ua->request($req);
# check the outcome
if ($res->is_success) {
print "\tThe given URL is : $url\n" if $verbose;
@filelisting = ($res->decoded_content =~ m/<a href=\"([^\"]*.rpm)/g);
foreach my $i (@filelisting){
print $i."\n" if $verbose;
}
print "\tgot list of files from mirror.\n" if $verbose;
return @filelisting;
}
die("Error: " . $res->status_line . "\n");
}
__END__
=head1 NAME
generateSettings.pl - OpenSLX script to extract full package names
from a given mirror.
=head1 SYNOPSIS
generateSettings.pl [options]
Options:
--if inputfile
--of outputfile
--url url of the mirror
--help brief help message
--verbose show files as they are being processed
--version show version
=head1 OPTIONS
=over 8
=item B<--if>
Select input file with package names in each line.
=item B<--of>
Select output file for complete package names to append.
=item B<--url>
Select a mirror directory for the desired distribution
=item B<--help>
Prints a brief help message and exits.
=item B<--verbose>
Prints information about each installed package as it is being processed.
=item B<--version>
Prints the version and exits.
=back
=cut