pf-tools commit: r573 [ccaillet-guest] - in /trunk: debian/changelog tools/dumpiplist.pl
parmelan-guest at users.alioth.debian.org
parmelan-guest at users.alioth.debian.org
Fri Jan 25 13:47:59 UTC 2008
Author: ccaillet-guest
Date: Fri Jan 25 13:47:58 2008
New Revision: 573
URL: http://svn.debian.org/wsvn/pf-tools/?sc=1&rev=573
Log:
* improving tool dumpiplist.pl (see -h or --help)
Modified:
trunk/debian/changelog
trunk/tools/dumpiplist.pl
Modified: trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pf-tools/trunk/debian/changelog?rev=573&op=diff
==============================================================================
--- trunk/debian/changelog (original)
+++ trunk/debian/changelog Fri Jan 25 13:47:58 2008
@@ -23,6 +23,7 @@
* Better substitution on Subst_vars, now if a %VAR% is not defined on SUBST
hash, the returned string is not broken
* adding %SECTIONNAME% handler on actions others than dpkg-purge and apt-get
+ * improving tool dumpiplist.pl (see -h or --help)
[ Thomas Parmelan ]
* lib-net: if no comment is specified in a zone, network or server
@@ -34,7 +35,7 @@
* Update my email address.
* Merge the remaining changes from 0.32.47-1 and 0.32.48-1.
- -- Christophe Caillet <quadchris at free.fr> Thu, 24 Jan 2008 12:57:43 +0100
+ -- Christophe Caillet <quadchris at free.fr> Fri, 25 Jan 2008 14:44:33 +0100
pf-tools (0.32.48-1) unstable; urgency=low
Modified: trunk/tools/dumpiplist.pl
URL: http://svn.debian.org/wsvn/pf-tools/trunk/tools/dumpiplist.pl?rev=573&op=diff
==============================================================================
--- trunk/tools/dumpiplist.pl (original)
+++ trunk/tools/dumpiplist.pl Fri Jan 25 13:47:58 2008
@@ -1,5 +1,8 @@
#!/usr/bin/perl
##
+## $Id$
+##
+## Copyright (C) 2008 Christophe Caillet <quadchris at free.fr>
## Copyright (C) 2004 Stephane Pontier <shad at sitadelle.com>
##
## This program is free software; you can redistribute it and/or
@@ -28,6 +31,15 @@
use PFTools::Net;
use PFTools::Update;
+use Getopt::Long qw ( :config ignore_case_always bundling ) ;
+
+my $help = 0 ;
+my $type = '' ;
+my $src = '' ;
+my $read = 0 ;
+my $program = $0;
+$program =~ s%.*/%%; # cheap basename
+my $version = sprintf( "svn-r%s", q$Revision$ =~ /([\d.]+)/ );
sub _ipcomp {
my ( $a, $b ) = @_;
@@ -49,89 +61,147 @@
return 0;
}
-if ( @ARGV == 0 or @ARGV > 2 ) {
- die "Usage: $0 fichier_private_network uml(0/1)\n";
-}
-
-my ( $file, $uml ) = @ARGV;
-$PFTools::Net::UML = 1 if $uml;
-
-my $bighash = Load_conf($file);
-
-#print Dumper ($bighash) ;
-my $nethash = {};
-foreach my $entry ( keys %{$bighash} ) {
-
- # print "On est sur la machine $entry\n";
- if ( defined $bighash->{$entry}->{'type'}
- and $bighash->{$entry}->{'type'} =~ /server/ )
- { # c'est une machine
- foreach my $interface ( keys %{ $bighash->{$entry}->{'interface'} } )
- {
- my $vlan = $bighash->{$entry}->{'interface'}->{$interface};
- my $netpatte = $bighash->{$vlan}->{'network'};
- my $netmaskpatte = $bighash->{$vlan}->{'netmask'};
- my $ippatte
- = defined $bighash->{$entry}->{'ipstart'}->{$vlan}
- ? $bighash->{$entry}->{'ipstart'}->{$vlan}
- : $bighash->{$entry}->{'ipstart'}->{'default'};
-
- if ( !defined( $bighash->{$entry}->{'number'} )
- or $bighash->{$entry}->{'number'} <= 1 )
- {
- $bighash->{$entry}->{'number'} = 1;
- }
-
-# print "INTERFACE:$interface PATTE:$netpatte MASK:$netmaskpatte IP:$ippatte VLAN:$vlan\n";
- my $numberpatte;
- foreach
- my $numberpatte ( 0 .. $bighash->{$entry}->{'number'} - 1 )
- {
-
- # on est soit dans le nouvelle addressage avec un
- # vlan en 10.128.0.0 et une ip de patte en 24.0
- if ( $ippatte =~ /(\d{1,3})\.(\d{0,3})/ )
- { #print "nouvel addr$ippatte\t";
- my $ippatteXX = "$1." . ( $2 + $numberpatte );
- $netpatte
- =~ s/(\d{1,3}\.\d{1,3}\.)\d{1,3}\.\d{1,3}/$1$ippatteXX/;
- }
- else { #print "ancien addr$ippatte\t";
- # soit en addressage de classe C avec
- # un vlan en 217.19.192.0
- # et une ip de patte en 96
- my $ippatteXX = $ippatte + $numberpatte;
- $netpatte
- =~ s/(\d{1,3}\.\d{1,3}\.\d{1,3}\.)\d{1,3}/$1$ippatteXX/;
- }
- my $ipkey = $netpatte;
-
- # print "on a maintenant la machine $entry avec:$netpatte\n";
- if ( defined $nethash->{$ipkey} ) {
- my $nmachine = $entry;
- $nmachine =~ s/%%/0$numberpatte/;
- print "$nmachine($interface)\t"
- . $netpatte
- . ": ip deja prise par "
- . "$nethash->{$ipkey}->{'machine'}($nethash->{$ipkey}->{'interface'})\n";
- $ipkey .= ".X";
- }
- my $machine = $entry;
- $machine =~ s/%%/0$numberpatte/;
- $nethash->{$ipkey}->{'vlan'} = $vlan;
- $nethash->{$ipkey}->{'ip'} = $netpatte;
- $nethash->{$ipkey}->{'netmask'} = $netmaskpatte;
- $nethash->{$ipkey}->{'interface'} = $interface;
- $nethash->{$ipkey}->{'machine'} = $machine;
- }
-
- }
- }
-}
-
-foreach my $ownip ( sort { &_ipcomp( $a, $b ) } keys %{$nethash} ) {
- print "$nethash->{$ownip}->{'ip'}\t"
- . $nethash->{$ownip}->{'machine'} . "("
- . $nethash->{$ownip}->{'interface'} . ")\n";
-}
-
+sub Do_help {
+ print STDERR << "# ENDHELP";
+ $program - version $version
+
+Usage: $program [options]
+ -h --help: print help and exit
+ -s --src: source file for private-network
+ -t --type: specify a server type to extract from global confifuration
+ -r --read: specify that output will be human readable
+
+# ENDHELP
+}
+
+sub order_servers ($) {
+ my ( $ref_net ) = @_ ;
+ my $result = [] ;
+ my $order = {} ;
+
+ foreach my $srv ( keys %{$ref_net} ) {
+ push ( @{$order->{$ref_net->{$srv}->{'order'}}}, $srv ) ;
+ }
+# foreach my $prio ( sort keys %{$order} ) {
+# foreach my $srv ( @{$order->{$prio}} ) {
+# push ( @{$result}, $srv ) ;
+# }
+# }
+ return $order ;
+}
+
+sub get_srv_iface ($$) {
+ my ( $srv_name, $ref_srv ) = @_ ;
+ my $ordered_vlan = {} ;
+ my $result = {} ;
+ foreach my $vlan ( keys %{$ref_srv->{'ifup'}} ) {
+ my $vlan_name = $vlan ;
+ $vlan_name =~ s/^$srv_name\.//;
+ $ordered_vlan->{$ref_srv->{'ifup'}->{$vlan}} = $vlan_name ;
+ }
+ foreach my $iface ( sort keys %{$ordered_vlan} ) {
+ $result->{$iface}->{'addr'} = $ref_srv->{'zone'}->{$srv_name.".".$ordered_vlan->{$iface}}->{'FIELD'} ;
+ $result->{$iface}->{'vlan'} = $ordered_vlan->{$iface} ;
+ }
+ return $result ;
+}
+
+sub get_srv_ip ($$) {
+ my ( $srv_type, $ref_net ) = @_ ;
+ my $result = {} ;
+
+ foreach my $srv ( keys %{$ref_net->{$srv_type}->{'SRVLIST'}} ) {
+ my $ref_srv = $ref_net->{$srv_type}->{'SRVLIST'}->{$srv} ;
+ foreach my $iface ( keys %{$ref_srv->{'zone'}} ) {
+ next if ( $iface !~ /^$srv\./ ) ;
+ $result->{$ref_srv->{'zone'}->{$iface}->{'FIELD'}}->{'hostname'} = $srv ;
+ $result->{$ref_srv->{'zone'}->{$iface}->{'FIELD'}}->{'iface'} = $ref_srv->{'ifup'}->{$iface} ;
+ }
+ }
+ return $result ;
+}
+
+sub get_all_ip ($) {
+ my ( $ref_net ) = @_ ;
+ my $result = {} ;
+
+ foreach my $srv_type ( keys %{$ref_net} ) {
+ foreach my $srv ( keys %{$ref_net->{$srv_type}->{'SRVLIST'}} ) {
+ my $ref_srv = $ref_net->{$srv_type}->{'SRVLIST'}->{$srv} ;
+ foreach my $iface ( keys %{$ref_srv->{'zone'}} ) {
+ next if ( $iface !~ /^$srv\./ ) ;
+ $result->{$ref_srv->{'zone'}->{$iface}->{'FIELD'}}->{'hostname'} = $srv ;
+ $result->{$ref_srv->{'zone'}->{$iface}->{'FIELD'}}->{'iface'} = $ref_srv->{'ifup'}->{$iface} ;
+ }
+ }
+ }
+ return $result ;
+}
+
+GetOptions (
+ 'help|h' => \$help,
+ 'type|t=s' => \$type,
+ 'read|r' => \$read,
+ 'src|s=s' => \$src
+) || die "Didn't grok options on CLI\n" ;
+
+if ( $help ) {
+ Do_help () ;
+ exit 0 ;
+}
+
+if ( ! $src ) {
+ die "Source file for network description is not defined\n" ;
+} elsif ( ! -e $src ) {
+ die $src." source file doesn't exist\n" ;
+}
+
+my $PF_NET = Init_lib_net ( Get_source ( $src ) );
+my $SRV_LIST = $PF_NET->{'SERVERS'}->{'BY_NAME'} ;
+
+if ( $type && ! defined $SRV_LIST->{$type} ) {
+ die "Non existant server type ".$type."\n" ;
+}
+
+# print Dumper $PF_NET;
+if ( $type ) {
+ if ( $read ) {
+ foreach my $srv ( sort keys %{$SRV_LIST->{$type}->{'SRVLIST'}} ) {
+ print "\t".$srv."\n" ;
+ my $srv_net = get_srv_iface ( $srv, $SRV_LIST->{$type}->{'SRVLIST'}->{$srv} ) ;
+ foreach my $iface ( sort keys %{$srv_net} ) {
+ print "\t\t".$iface."(".$srv_net->{$iface}->{'vlan'}.")\t: ".$srv_net->{$iface}->{'addr'}."\n" ;
+ }
+ }
+ }
+ else {
+ my $srv_ip = get_srv_ip ( $type, $SRV_LIST ) ;
+ foreach my $ip ( sort { _ipcomp ( $a, $b ) } keys %{$srv_ip} ) {
+ print $ip."\t".$srv_ip->{$ip}->{'hostname'}."(".$srv_ip->{$ip}->{'iface'}.")\n" ;
+ }
+ }
+} else {
+ if ( $read ) {
+ my $srv_type_list = order_servers ( $SRV_LIST ) ;
+ foreach my $prio ( sort keys %{$srv_type_list} ) {
+ print "Server with deployment priority : ".$prio."\n" ;
+ foreach my $srv_type ( sort @{$srv_type_list->{$prio}} ) {
+ foreach my $srv ( sort keys %{$SRV_LIST->{$srv_type}->{'SRVLIST'}} ) {
+ print "\t".$srv."\n" ;
+ my $srv_net = get_srv_iface ( $srv, $SRV_LIST->{$srv_type}->{'SRVLIST'}->{$srv} ) ;
+ foreach my $iface ( sort keys %{$srv_net} ) {
+ print "\t\t".$iface."(".$srv_net->{$iface}->{'vlan'}.")\t: ".$srv_net->{$iface}->{'addr'}."\n" ;
+ }
+ }
+ print "\n" ;
+ }
+ print "\n" ;
+ }
+ }
+ else {
+ my $ip_list = get_all_ip ( $SRV_LIST ) ;
+ foreach my $ip ( sort { _ipcomp ( $a, $b ) } keys %{$ip_list} ) {
+ print $ip."\t".$ip_list->{$ip}->{'hostname'}."(".$ip_list->{$ip}->{'iface'}.")\n" ;
+ }
+ }
+}
More information about the pf-tools-commits
mailing list