Changeset 61 for trunk/klask


Ignore:
Timestamp:
Sep 4, 2009, 4:28:18 PM (15 years ago)
Author:
g7moreau
Message:
  • Many change to suppress many warning
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/klask

    r60 r61  
    77use strict;
    88use warnings;
    9 use version; our $VERSION = qv('0.5.5');
    10 
    11 use Readonly;
    12 use Filehandle;
     9
    1310use Net::SNMP;
    1411#use YAML;
     
    3229my $KLASK_CFG = YAML::Syck::LoadFile("$KLASK_CFG_FILE");
    3330
    34 my %DEFAULT = %{ $KLASK_CFG->{default} };
    35 my @SWITCH  = @{ $KLASK_CFG->{switch}  };
     31my %DEFAULT = %{$KLASK_CFG->{default}};
     32my @SWITCH  = @{$KLASK_CFG->{switch}};
    3633
    3734my %switch_level = ();
    38 my %SWITCH_DB    = ();
     35my %SWITCH_DB = ();
    3936LEVEL_OF_EACH_SWITCH:
    4037for my $sw (@SWITCH){
     
    4239   $SWITCH_DB{$sw->{hostname}} = $sw;
    4340   }
    44 @SWITCH = reverse sort { $switch_level{$a->{hostname}} <=> $switch_level{$b->{hostname}} } @{$KLASK_CFG->{switch}};
     41@SWITCH = sort { $switch_level{$b->{hostname}} <=> $switch_level{$a->{hostname}} } @{$KLASK_CFG->{switch}}; 
    4542
    4643my %SWITCH_PORT_COUNT = ();
     
    6360   );
    6461
    65 Readonly my %INTERNAL_PORT_MAP => (
     62my %INTERNAL_PORT_MAP = (
    6663   0 => 'A',
    6764   1 => 'B',
     
    7370   7 => 'H',
    7471   );
    75 Readonly my %INTERNAL_PORT_MAP_REV => reverse %INTERNAL_PORT_MAP;
    76 
    77 Readonly my %SWITCH_KIND => (
     72my %INTERNAL_PORT_MAP_REV = reverse %INTERNAL_PORT_MAP;
     73
     74my %SWITCH_KIND = (
    7875   J3299A => { model => 'HP224M',     match => 'HP J3299A ProCurve Switch 224M'  },
    7976   J4120A => { model => 'HP1600M',    match => 'HP J4120A ProCurve Switch 1600M' },
     
    9087   BS350T => { model => 'BS350T',     match => 'BayStack 350T HW'                },
    9188   );
    92 
    93 Readonly my %OID_NUMBER => (
    94    sysDescription  => '1.3.6.1.2.1.1.1.0',
    95    sysName         => '1.3.6.1.2.1.1.5.0',
    96    sysContact      => '1.3.6.1.2.1.1.4.0',
    97    sysLocation     => '1.3.6.1.2.1.1.6.0',
     89 
     90my %OID_NUMBER = (
     91   sysDescr    => '1.3.6.1.2.1.1.1.0',
     92   sysName     => '1.3.6.1.2.1.1.5.0',
     93   sysContact  => '1.3.6.1.2.1.1.4.0',
     94   sysLocation => '1.3.6.1.2.1.1.6.0',
    9895   );
    99 
    100 Readonly my $RE_MAC_ADDRESS  => qr{ [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} : [0-9,A-Z]{2} }xms;
    101 Readonly my $RE_IPv4_ADDRESS => qr{ [0-9]{1,3} \. [0-9]{1,3} \. [0-9]{1,3} \. [0-9]{1,3} }xms;
    102 
    10396
    10497################
     
    111104   }
    112105else {
    113    print {*STDERR} "klask: command $cmd not found\n\n";
     106   print STDERR "klask: command $cmd not found\n\n";
    114107   $CMD_DB{help}->();
    115108   exit 1;
     
    121114   die "Configuration file $KLASK_CFG_FILE does not exists. Klask need it !\n" if not -e "$KLASK_CFG_FILE";
    122115   die "Var folder $KLASK_VAR does not exists. Klask need it !\n"              if not -d "$KLASK_VAR";
    123    return;
    124116   }
    125117
    126118sub test_switchdb_environnement {
    127119   die "Switch database $KLASK_SW_FILE does not exists. Launch updatesw before this command !\n" if not -e "$KLASK_SW_FILE";
    128    return;
    129120   }
    130121
    131122sub test_maindb_environnement {
    132123   die "Main database $KLASK_DB_FILE does not exists. Launch updatedb before this command !\n" if not -e "$KLASK_DB_FILE";
    133    return;
    134124   }
    135125
     
    138128sub fastping {
    139129   system "fping -c 1 @_ >/dev/null 2>&1";
    140    return;
    141    }
    142 
    143 sub shell_command {
    144    my $cmd = shift;
    145 
    146    my $fh = new Filehandle;
    147    open $fh, q{-|}, "$cmd" or die "Can't exec $cmd\n";
    148    my $result = <$fh>;
    149    close $fh;
    150    chomp $result;
    151    return $result;
    152130   }
    153131
     
    156134sub resolve_ip_arp_host {
    157135   my $param_ip_or_host = shift;
    158    my $interface = shift || q{*};
    159    my $type      = shift || q{fast};
     136   my $interface = shift || '*';
     137   my $type      = shift || 'fast';
    160138
    161139   my %ret = (
     
    166144
    167145#   my $cmdarping  = `arping -c 1 -w 1 -rR $param 2>/dev/null`;
    168    if ( not $param_ip_or_host =~ m/^\d+ \. \d+ \. \d+ \. \d+$/xms ) {
    169       $param_ip_or_host =~ s/ \. .* //xms;
     146   if (not $param_ip_or_host =~ m/^\d+\.\d+\.\d+\.\d+$/) {
     147      $param_ip_or_host =~ s/\..*//;
    170148      }
    171149
     
    176154   # my $cmd = "grep  -e '".'\b'."$param_ip_or_host".'\b'."' /var/lib/arpwatch/arp.dat | sort +2rn | head -1";
    177155   # my $cmd = "grep  -he '".'\b'."$param_ip_or_host".'\b'."' /var/lib/arpwatch/*.dat | sort +2rn | head -1";
    178    my $cmd = q{grep  -he '\b} . $param_ip_or_host . q{\b' } . "/var/lib/arpwatch/$interface.dat | sort -rn -k 3,3 | head -1";
    179    my $cmd_arpwatch = shell_command $cmd;
    180    my ($arp, $ip, $timestamp, $host) = split m/ \s+ /xms, $cmd_arpwatch;
     156   my $cmd = "grep  -he '".'\b'."$param_ip_or_host".'\b'."' /var/lib/arpwatch/$interface.dat | sort -rn -k 3,3 | head -1";
     157   my $cmd_arpwatch = `$cmd`;
     158   chomp $cmd_arpwatch;
     159   my ($arp, $ip, $timestamp, $host) = split /\s+/, $cmd_arpwatch;
     160
     161#print "OOO $cmd\n";
     162#print "TTT arp $arp -> $ip pour host $host\n";
    181163
    182164   $ret{ipv4_address} = $ip        if $ip;
     
    184166   $ret{timestamp}    = $timestamp if $timestamp;
    185167
    186    my $nowtimestamp = time;
     168   my $nowtimestamp = time();
    187169
    188170   if ( $type eq 'fast' and ( not defined $timestamp or $timestamp < ( $nowtimestamp - 3 * 3600 ) ) ) {
     
    191173      }
    192174
    193    # resultat de la commande arp
     175  # resultat de la commande arp
    194176   # tech7meylan.hmg.inpg.fr (194.254.66.240) at 00:14:22:45:28:A9 [ether] on eth0
    195177   # sw2-batF0-legi.hmg.priv (192.168.22.112) at 00:30:c1:76:9c:01 [ether] on eth0.37
    196    my $cmd_arp  = shell_command "arp -a $param_ip_or_host";
    197    if ( $cmd_arp =~ m{ (\S*) \s \( ( $RE_IPv4_ADDRESS ) \) \s at \s ( $RE_MAC_ADDRESS ) }xms ) {
    198       ( $ret{hostname_fq}, $ret{ipv4_address}, $ret{mac_address} )  = ($1, $2, $3);
    199       }
    200 
    201    # resultat de la commande host si le parametre est ip
    202    # 250.66.254.194.in-addr.arpa domain name pointer legihp2100.hmg.inpg.fr.
    203    my $cmd_host = shell_command "host $param_ip_or_host";
    204    if ( $cmd_host =~ m/domain \s name \s pointer \s (\S+) \.$/xms ) {
    205       $ret{hostname_fq} = $1;
    206       }
    207 
    208    # resultat de la commande host si parametre est hostname
    209    # tech7meylan.hmg.inpg.fr has address 194.254.66.240
    210    if ( $cmd_host =~ m/(\S*) \s has \s address \s ( $RE_IPv4_ADDRESS )$/xms ) {
    211       ( $ret{hostname_fq}, $ret{ipv4_address} ) = ($1, $2);
    212       }
    213 
    214    if ( $cmd_host =~ m/ \b ( $RE_IPv4_ADDRESS ) \. in-addr \. arpa \s/xms ) {
    215       $ret{ipv4_address} = $1;
    216       }
    217    #$ret{hostname_fq}  = $param_ip_or_host if not defined $1 and $ret{hostname_fq} eq 'unknow';
    218 
    219    if ($ret{mac_address} ne 'unknow') {
     178   my $cmd_arp  = `arp -a $param_ip_or_host 2>/dev/null`;
     179   chomp $cmd_arp;
     180   $cmd_arp =~ /(\S*)\s\(([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})\)\sat\s([0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2}:[0-9,A-Z]{2})/;
     181   $ret{hostname_fq}  = $1 if(defined($1));
     182   $ret{ipv4_address} = $2 if(defined($2));
     183   $ret{mac_address}  = $3 if(defined($3));
     184#print "RET1 $ret{ipv4_address} -> $ret{mac_address} : $ret{hostname_fq}\n";
     185
     186#   if ($ret{ipv4_address} eq '0.0.0.0' and $ret{mac_address} eq 'unknow'and $ret{hostname_fq} eq 'unknow') {
     187      # resultat de la commande host si le parametre est ip
     188      # 250.66.254.194.in-addr.arpa domain name pointer legihp2100.hmg.inpg.fr.
     189      my $cmd_host = `host $param_ip_or_host 2>/dev/null`;
     190      chomp $cmd_host;
     191      $cmd_host =~ m/domain\sname\spointer\s(\S+)\.$/;
     192      $ret{hostname_fq} = $1 if defined $1;
     193
     194      # resultat de la commande host si parametre est hostname
     195      # tech7meylan.hmg.inpg.fr has address 194.254.66.240
     196      $cmd_host =~ m/(\S*)\shas\saddress\s([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})$/;
     197      $ret{hostname_fq}  = $1 if defined $1;
     198      $ret{ipv4_address} = $2 if defined $2;
     199
     200      $cmd_host =~ m/\b([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.in-addr\.arpa\s/;
     201      $ret{ipv4_address} = "$4.$3.$2.$1"     if defined $1 and  defined $2 and  defined $3 and  defined $4;
     202      $ret{hostname_fq}  = $param_ip_or_host if not defined $1 and $ret{hostname_fq} eq 'unknow';
     203#      }
     204
     205#print "RET2 $ret{ipv4_address} -> $ret{mac_address} : $ret{hostname_fq}\n";
     206   unless ($ret{mac_address} eq 'unknow') {
    220207      my @paquets = ();
    221       foreach ( split m/ : /xms, $ret{mac_address} ) {
    222          my @chars = split m//xms, uc "00$_";
     208      foreach ( split(/:/, $ret{mac_address}) ) {
     209         my @chars = split //, uc("00$_");
    223210         push @paquets, "$chars[-2]$chars[-1]";
    224211         }
    225       $ret{mac_address} = join q{:}, @paquets;
    226       }
    227 
     212      $ret{mac_address} = join ':', @paquets;
     213      }
     214
     215#print "RET3 $ret{ipv4_address} -> $ret{mac_address} : $ret{hostname_fq}\n";
    228216   return %ret;
    229217   }
     
    232220sub get_switch_model {
    233221   my $sw_snmp_description = shift || 'unknow';
    234 
     222   
    235223   for my $sw_kind (keys %SWITCH_KIND) {
    236       next if not $sw_snmp_description =~ m/$SWITCH_KIND{$sw_kind}->{match}/xms;
    237 
     224      next if not $sw_snmp_description =~ m/$SWITCH_KIND{$sw_kind}->{match}/;
     225     
    238226      return $SWITCH_KIND{$sw_kind}->{model};
    239227      }
    240 
     228     
    241229   return $sw_snmp_description;
    242230   }
     
    246234sub init_switch_names {
    247235   my $verbose = shift;
    248 
     236   
    249237   printf "%-25s                %-25s %s\n",'Switch','Description','Type';
     238#   print "Switch description\n" if $verbose;
    250239   print "-------------------------------------------------------------------------\n" if $verbose;
    251240
     
    255244         $session{-version} = $sw->{version}   || 1;
    256245         $session{-port}    = $sw->{snmpport}  || $DEFAULT{snmpport}  || 161;
    257          if (exists $sw->{version} and $sw->{version} eq '3') {
     246         if (exists $sw->{version} and $sw->{version} eq 3) {
    258247            $session{-username} = $sw->{username} || 'snmpadmin';
    259248            }
     
    269258      my $result = $session->get_request(
    270259         -varbindlist => [
    271             $OID_NUMBER{sysDescription},
     260            $OID_NUMBER{sysDescr},
    272261            $OID_NUMBER{sysName},
    273262            $OID_NUMBER{sysContact},
     
    276265         );
    277266      $sw->{description} = $result->{$OID_NUMBER{sysName}} || $sw->{hostname};
    278       $sw->{model} = get_switch_model( $result->{$OID_NUMBER{sysDescription}});
     267      $sw->{model} = get_switch_model( $result->{$OID_NUMBER{sysDescr}});
    279268      #$sw->{location} = $result->{"1.3.6.1.2.1.1.6.0"} || $sw->{hostname};
    280269      #$sw->{contact} = $result->{"1.3.6.1.2.1.1.4.0"} || $sw->{hostname};
    281270      $session->close;
    282271
    283       # Ligne à virer car on récupère maintenant le modèle du switch
    284       my ($desc, $type) = split m/ : /xms, $sw->{description}, 2;
     272      # Ligne à virer car on récupère maintenant le modèle du switch
     273      my ($desc, $type) = split ':', $sw->{description}, 2;
     274#      printf "%-25s 0--------->>>> %-25s %s\n", $sw->{hostname}, $desc, uc($type)."**" if $verbose;
    285275      printf "%-25s 0--------->>>> %-25s %s\n", $sw->{hostname}, $desc, $sw->{model} if $verbose;
    286276      }
    287277
    288278   print "\n" if $verbose;
    289    return;
    290279   }
    291280
     
    294283sub hex_to_dec {
    295284   #00:0F:1F:43:E4:2B
    296    my $car = '00' . uc shift;
     285   my $car = '00' . uc(shift);
    297286
    298287   return '00' if $car eq '00UNKNOW';
    299288   my %table = (
    300       '0'=>'0',  '1'=>'1',  '2'=>'2',  '3'=>'3',  '4'=>'4',
    301       '5'=>'5',  '6'=>'6',  '7'=>'7',  '8'=>'8',  '9'=>'9',
    302       'A'=>'10', 'B'=>'11', 'C'=>'12', 'D'=>'13', 'E'=>'14', 'F'=>'15',
     289      "0"=>"0",  "1"=>"1",  "2"=>"2",  "3"=>"3",  "4"=>"4",  "5"=>"5", "6"=>"6", "7"=>"7", "8"=>"8", "9"=>"9",
     290      "A"=>"10", "B"=>"11", "C"=>"12", "D"=>"13", "E"=>"14", "F"=>"15"
    303291      );
    304    my @chars = split m//xms, $car;
     292   my @chars = split(//, $car);
    305293   return $table{$chars[-2]}*16 + $table{$chars[-1]};
    306294   }
     
    312300   my $arp = shift;
    313301
    314    my @paquets = split m/ : /xms, $arp;
    315    my $return = q{};
     302   my @paquets = split /:/, $arp;
     303   my $return = '';
    316304   foreach(@paquets) {
    317       $return .= q{.} . hex_to_dec($_);
     305      $return .= ".".hex_to_dec($_);
    318306      }
    319307   return $return;
     
    323311# va rechercher le port et le switch sur lequel est la machine
    324312sub find_switch_port {
    325    my $arp             = shift;
    326    my $switch_proposal = shift || q{};
    327 
     313   my $arp = shift;
     314   my $switch_proposal = shift || '';
     315   
    328316   my %ret;
    329    $ret{switch_description} = 'unknow';
    330    $ret{switch_port} = '0';
     317   $ret{switch_description} = "unknow";
     318   $ret{switch_port} = "0";
    331319
    332320   return %ret if $arp eq 'unknow';;
    333321
    334322   my @switch_search = @SWITCH;
    335    if ($switch_proposal ne q{}) {
     323   if ($switch_proposal ne '') {
    336324      for my $sw (@SWITCH) {
    337325         next if $sw->{hostname} ne $switch_proposal;
     
    341329      }
    342330
    343    my $research = '1.3.6.1.2.1.17.4.3.1.2' . arp_hex_to_dec($arp);
    344 
     331   my $research = "1.3.6.1.2.1.17.4.3.1.2".arp_hex_to_dec($arp);
     332   
    345333   LOOP_ON_SWITCH:
    346334   for my $sw (@switch_search) {
     
    351339         -varbindlist => [$research]
    352340         );
    353       if (not defined $result or $result->{$research} eq 'noSuchInstance') {
     341      if (not defined($result) or $result->{$research} eq 'noSuchInstance') {
    354342         $session->close;
    355343         next LOOP_ON_SWITCH;
     
    360348
    361349         # IMPORTANT !!
    362          # ceci empeche la detection sur certains port ...
     350         # ceci empeche la detection sur certains port ... 
    363351         # en effet les switch sont relies entre eux par un cable reseau et du coup
    364352         # tous les arp de toutes les machines sont presentes sur ces ports (ceux choisis ici sont les miens)
     
    376364            $ret{switch_description} = $sw->{description};
    377365            $ret{switch_port}        = get_human_readable_port($sw->{model}, $swport); # $swport;
    378 
     366           
    379367            last LOOP_ON_SWITCH;
    380368#            }
     
    398386      }
    399387
    400    my $research = '1.3.6.1.2.1.17.4.3.1.2' . arp_hex_to_dec($arp);
     388   my $research = "1.3.6.1.2.1.17.4.3.1.2".arp_hex_to_dec($arp);
    401389   LOOP_ON_ALL_SWITCH:
    402390   for my $sw (@SWITCH) {
     
    408396         );
    409397
    410       if(defined $result and $result->{$research} ne 'noSuchInstance'){
     398      if(defined($result) and $result->{$research} ne 'noSuchInstance'){
    411399         my $swport = $result->{$research};
    412400
     
    434422   return $KLASK_CFG->{network}{$network}{interface};
    435423   }
    436 
     424 
    437425###
    438426# liste l'ensemble des adresses ip d'un réseau
     
    445433      my @line  = @{$KLASK_CFG->{network}{$net}{'ip-subnet'}};
    446434      for my $cmd (@line) {
    447          for my $method (keys %{$cmd}){
     435         for my $method (keys %$cmd){
    448436            $cidrlist->add_any($cmd->{$method}) if $method eq 'add';
    449437            }
     
    455443   for my $cidr ($cidrlist->list()) {
    456444      my $net = new NetAddr::IP $cidr;
    457       for my $ip (@{$net}) {
    458          $ip =~ s{ /32 }{}xms;
     445      for my $ip (@$net) {
     446         $ip =~ s#/32##;
    459447         push @res,  $ip;
    460448         }
     
    480468   my $sw_model = shift;
    481469   my $sw_port  = shift;
    482 
     470   
    483471   return $sw_port if not $sw_model eq 'HP8000M';
    484 
     472   
    485473   my $reste = (($sw_port - 1) % 8) + 1;
    486    my $major = int (($sw_port - 1) / 8);
     474   my $major = int( ($sw_port - 1) / 8 );
    487475
    488476   return "$INTERNAL_PORT_MAP{$major}$reste";
     
    492480   my $sw_model = shift;
    493481   my $sw_port  = shift;
    494 
     482   
    495483   return $sw_port if not $sw_model eq 'HP8000';
    496484
    497    my $letter = substr $sw_port, 0, 1;
    498 
     485   my $letter = substr($sw_port, 0, 1);
     486   
    499487#   return $port if $letter =~ m/\d/;
    500 
    501    my $reste =  substr $sw_port, 1;
    502 
     488   
     489   my $reste =  substr($sw_port, 1);
     490   
    503491   return $INTERNAL_PORT_MAP_REV{$letter} * 8 + $reste;
    504492   }
     
    510498sub cmd_help {
    511499
    512 print <<'END';
     500print <<END;
    513501klask - ports manager and finder for switch
    514502
     
    526514 klask status  switch port
    527515END
    528    return;
    529516   }
    530517
    531518sub cmd_version {
    532519
    533 print <<'END';
     520print <<END;
    534521Klask - ports manager and finder for switch
    535522Copyright (C) 2005-2008 Gabriel Moreau
     
    539526   print ' $Date$'."\n";
    540527   print ' $Id$'."\n";
    541    return;
    542528   }
    543529
    544530sub cmd_search {
    545531   my @computer = @_;
    546 
     532   
    547533   init_switch_names();    #nomme les switchs
    548534   fastping(@computer);
     
    550536      my %resol_arp = resolve_ip_arp_host($clientname);          #resolution arp
    551537      my %where     = find_switch_port($resol_arp{mac_address}); #retrouve l'emplacement
    552       printf '%-22s %2i %-30s %-15s %18s', $where{switch_description}, $where{switch_port}, $resol_arp{hostname_fq}, $resol_arp{ipv4_address}, $resol_arp{mac_address}."\n"
     538      printf "%-22s %2i %-30s %-15s %18s", $where{switch_description}, $where{switch_port}, $resol_arp{hostname_fq}, $resol_arp{ipv4_address}, $resol_arp{mac_address}."\n"
    553539         unless $where{switch_description} eq 'unknow' and $resol_arp{hostname_fq} eq 'unknow' and $resol_arp{mac_address} eq 'unknow';
    554540      }
    555    return;
    556541   }
    557542
     
    561546   fastping(@computer);
    562547   my $computerdb = YAML::Syck::LoadFile("$KLASK_DB_FILE");
    563 
     548   
    564549   LOOP_ON_COMPUTER:
    565550   for my $clientname (@computer) {
    566551      my %resol_arp = resolve_ip_arp_host($clientname);      #resolution arp
    567552      my $ip = $resol_arp{ipv4_address};
    568 
     553     
    569554      next LOOP_ON_COMPUTER unless exists $computerdb->{$ip};
    570 
    571       my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $computerdb->{$ip}{timestamp};
     555     
     556      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($computerdb->{$ip}{timestamp});
    572557      $year += 1900;
    573558      $mon++;
    574       my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
     559      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
    575560
    576561      printf "%-22s %2s %-30s %-15s %-18s %s\n",
     
    582567         $date;
    583568      }
    584    return;
    585569   }
    586570
     
    599583
    600584   my $number_of_computer = get_list_ip(@network); # + 1;
    601    my $size_of_database   = keys %{$computerdb};
     585   my $size_of_database   = keys %$computerdb;
    602586      $size_of_database   = 1 if $size_of_database == 0;
    603587   my $i = 0;
     
    611595   my %db_switch_connected_on_port = %{$switch_connection->{connected_on_port}};
    612596   my %db_switch_chained_port = ();
    613    for my $swport (keys %db_switch_connected_on_port) {
    614       my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
     597   for my $swport (keys %db_switch_connected_on_port) {       
     598      my ($sw_connect,$port_connect) = split ':', $swport;
    615599      $db_switch_chained_port{$sw_connect} .= "$port_connect:";
    616600      }
     
    619603      if ( exists $db_switch_chained_port{$sw->{hostname}} ) {
    620604         chop $db_switch_chained_port{$sw->{hostname}};
    621          push @{$sw->{portignore}}, split m/ : /xms, $db_switch_chained_port{$sw->{hostname}};
     605         push @{$sw->{portignore}}, split(':',$db_switch_chained_port{$sw->{hostname}});
    622606         }
    623607#      print "$sw->{hostname} ++ @{$sw->{portignore}}\n";
     
    644628      for my $one_computer (@computer) {
    645629         $i++;
    646 
    647          my $total_percent = int (($i*100)/$number_of_computer);
     630         
     631         my $total_percent = int(($i*100)/$number_of_computer);
    648632
    649633         my $localtime = time - $timestamp;
    650          my ($sec,$min) = localtime $localtime;
     634         my ($sec,$min) = localtime($localtime);
    651635
    652636         my $time_elapse = 0;
    653637            $time_elapse = $localtime * ( 100 - $total_percent) / $total_percent if $total_percent != 0;
    654          my ($sec_elapse,$min_elapse) = localtime $time_elapse;
     638         my ($sec_elapse,$min_elapse) = localtime($time_elapse);
    655639
    656640         printf "\rComputer scanned: %4i/%i (%2i%%)",  $i,                 $number_of_computer, $total_percent;
    657641#         printf ", Computer detected: %4i/%i (%2i%%)", $detected_computer, $size_of_database,   int(($detected_computer*100)/$size_of_database);
    658          printf ', detected: %4i/%i (%2i%%)', $detected_computer, $size_of_database,   int(($detected_computer*100)/$size_of_database);
    659          printf ' [Time: %02i:%02i / %02i:%02i]', int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
    660 #         printf '  [%02i:%02i/%02i:%02i]', int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
    661          printf ' %-14s', $one_computer;
     642         printf ", detected: %4i/%i (%2i%%)", $detected_computer, $size_of_database,   int(($detected_computer*100)/$size_of_database);
     643         printf " [Time: %02i:%02i / %02i:%02i]", int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
     644#         printf "  [%02i:%02i/%02i:%02i]", int($localtime/60), $localtime % 60, int($time_elapse/60), $time_elapse % 60;
     645         printf " %-14s", $one_computer;
    662646
    663647         my %resol_arp = resolve_ip_arp_host($one_computer,$current_interface);
    664 
     648         
    665649         # do not search on router connection (why ?)
    666650         if ( exists $router_mac_ip{$resol_arp{mac_address}}) {
     
    675659            }
    676660
    677          my $switch_proposal = q{};
     661         my $switch_proposal = '';
    678662         if (exists $computerdb->{$resol_arp{ipv4_address}} and exists $computerdb->{$resol_arp{ipv4_address}}{switch_hostname}) {
    679663            $switch_proposal = $computerdb->{$resol_arp{ipv4_address}}{switch_hostname};
     
    732716         # mise a jour du nom de la machine si modification dans le dns
    733717         $computerdb->{$resol_arp{ipv4_address}}{hostname_fq} = $resol_arp{hostname_fq};
    734 
     718       
    735719         # mise à jour de la date de détection si détection plus récente par arpwatch
    736720         $computerdb->{$resol_arp{ipv4_address}}{timestamp}   = $resol_arp{timestamp} if exists $resol_arp{timestamp} and $computerdb->{$resol_arp{ipv4_address}}{timestamp} < $resol_arp{timestamp};
    737721
     722         # provisoire car changement de nom des attributs
     723#         $computerdb->{$resol_arp{ipv4_address}}{mac_address}        = $computerdb->{$resol_arp{ipv4_address}}{arp};
     724#         $computerdb->{$resol_arp{ipv4_address}}{switch_description} = $computerdb->{$resol_arp{ipv4_address}}{switch};
     725#         $computerdb->{$resol_arp{ipv4_address}}{switch_port}        = $computerdb->{$resol_arp{ipv4_address}}{port};
     726       
    738727         # relance un arping sur la machine si celle-ci n'a pas été détectée depuis plus d'une semaine
    739728#         push @computer_not_detected, $resol_arp{ipv4_address} if $computerdb->{$resol_arp{ipv4_address}}{timestamp} < $timestamp_last_week;
    740729         $computer_not_detected{$resol_arp{ipv4_address}} = $current_interface if $computerdb->{$resol_arp{ipv4_address}}{timestamp} < $timestamp_last_week;
    741 
     730       
    742731         }
    743732      }
     
    747736
    748737   my $dirdb = $KLASK_DB_FILE;
    749       $dirdb =~ s{ / [^/]* $}{}xms;
     738      $dirdb =~ s#/[^/]*$##;
    750739   mkdir "$dirdb", 0755 unless -d "$dirdb";
    751740   YAML::Syck::DumpFile("$KLASK_DB_FILE", $computerdb);
     
    756745#      print  "arping -c 1 -w 1 -rR -i $interface $one_computer 2>/dev/null\n";
    757746      }
    758    return;
    759747   }
    760748
     
    775763
    776764   my $dirdb = $KLASK_DB_FILE;
    777       $dirdb =~ s{ / [^/]* $}{}xms;
     765      $dirdb =~ s#/[^/]*$##;
    778766   mkdir "$dirdb", 0755 unless -d "$dirdb";
    779767   YAML::Syck::DumpFile("$KLASK_DB_FILE", $computerdb);
    780    return;
    781768   }
    782769
     
    796783
    797784   $format = 'txt' if not defined $possible_format{$format};
    798 
     785   
    799786   $possible_format{$format}->(@ARGV);
    800    return;
    801787   }
    802788
     
    810796
    811797   LOOP_ON_IP_ADDRESS:
    812    foreach my $ip (Net::Netmask::sort_by_ip_address(keys %{$computerdb})) {
    813 
     798   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %$computerdb)) {
     799   
    814800#      next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq 'unknow';
    815801
     
    819805# dans le futur
    820806#      next if $computerdb->{$ip}{hostname_fq} eq 'unknow';
    821 
    822       my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $computerdb->{$ip}{timestamp};
     807     
     808      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($computerdb->{$ip}{timestamp});
    823809      $year += 1900;
    824810      $mon++;
    825       my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
     811      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
    826812
    827813      printf "%-25s  %2s  <-------  %-30s %-15s %-18s %s\n",
     
    833819         $date;
    834820      }
    835    return;
    836821   }
    837822
     
    844829#<script src="sorttable-klask.js"></script>
    845830
    846    print <<'END_HTML';
     831   print <<END;
    847832<table class="sortable" summary="Klask export database">
    848833 <caption>Klask database</caption>
     
    870855 </tfoot>
    871856 <tbody>
    872 END_HTML
     857END
    873858
    874859   my %mac_count = ();
    875860   LOOP_ON_IP_ADDRESS:
    876    foreach my $ip (keys %{$computerdb}) {
    877 
     861   foreach my $ip (keys %$computerdb) {
     862   
    878863      # to be improve in the future
    879864      next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq ($computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description}); # switch on himself !
    880 
     865     
    881866      $mac_count{$computerdb->{$ip}{mac_address}}++;
    882867      }
     
    885870
    886871   LOOP_ON_IP_ADDRESS:
    887    foreach my $ip (Net::Netmask::sort_by_ip_address(keys %{$computerdb})) {
    888 
     872   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %$computerdb)) {
     873   
    889874      # to be improve in the future
    890875      next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq ($computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description}); # switch on himself !
    891876
    892       my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $computerdb->{$ip}{timestamp};
     877      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($computerdb->{$ip}{timestamp});
    893878      $year += 1900;
    894879      $mon++;
    895       my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
     880      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
    896881
    897882#      $odd_or_even++;
    898883#      my $typerow = $odd_or_even % 2 ? 'odd' : 'even';
    899       $typerow = $typerow eq 'even' ? 'odd' : 'even';
     884      $typerow = $typerow eq 'even' ? 'odd' : 'even'; 
    900885
    901886      my $switch_hostname = $computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description} || 'unkown';
    902887      chomp $switch_hostname;
    903       my $switch_hostname_sort = sprintf '%s %3s' ,$switch_hostname, $computerdb->{$ip}{switch_port};
    904 
    905       my $ip_sort = sprintf '%03i%03i%03i%03i', split m/ \. /xms, $ip;
    906 
    907       my $mac_sort = sprintf '%04i-%s', 9999 - $mac_count{$computerdb->{$ip}{mac_address}}, $computerdb->{$ip}{mac_address};
    908 
    909       $computerdb->{$ip}{hostname_fq} = 'unknow' if $computerdb->{$ip}{hostname_fq} =~ m/^ \d+ \. \d+ \. \d+ \. \d+ $/xms;
    910       my ( $host_short ) = split m/ \. /xms, $computerdb->{$ip}{hostname_fq};
    911 
    912       print <<"END_HTML";
     888      my $switch_hostname_sort = sprintf "%s %3s" ,$switch_hostname, $computerdb->{$ip}{switch_port};
     889
     890      my $ip_sort = sprintf "%03i%03i%03i%03i", split( /\./, $ip);
     891
     892      my $mac_sort = sprintf "%04i-%s", 9999 - $mac_count{$computerdb->{$ip}{mac_address}}, $computerdb->{$ip}{mac_address};
     893
     894      $computerdb->{$ip}{hostname_fq} = 'unknow' if $computerdb->{$ip}{hostname_fq} =~ m/^\d+\.\d+\.\d+\.\d+$/;
     895      my ( $host_short ) = split /\./, $computerdb->{$ip}{hostname_fq};
     896
     897      print <<END;
    913898  <tr class="$typerow">
    914899   <td sorttable_customkey="$switch_hostname_sort">$switch_hostname</td>
     
    920905   <td>$date</td>
    921906  </tr>
    922 END_HTML
     907END
    923908      }
    924909
     
    932917   for my $sw (sort keys %db_switch_output_port) {
    933918
    934       my $switch_hostname_sort = sprintf '%s %3s' ,$sw, $db_switch_output_port{$sw};
    935 
    936       $typerow = $typerow eq 'even' ? 'odd' : 'even';
     919      my $switch_hostname_sort = sprintf "%s %3s" ,$sw, $db_switch_output_port{$sw};
     920
     921      $typerow = $typerow eq 'even' ? 'odd' : 'even'; 
    937922
    938923      if (exists $db_switch_parent{$sw}) {
     
    945930      $year += 1900;
    946931      $mon++;
    947       my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year, $mon, $mday, $hour, $min;
    948 
    949       my $ip_sort = sprintf '%03i%03i%03i%03i', split m/ \. /xms, $ipv4_address;
    950 
    951       my $mac_sort = sprintf '%04i-%s', 9999, $mac_address;
    952 
    953       my ( $host_short ) = sprintf '%s %3s' , split(m/ \. /xms, $db_switch_parent{$sw}->{switch}, 1), $db_switch_parent{$sw}->{port};
    954 
    955       print <<"END_HTML";
     932      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
     933
     934      my $ip_sort = sprintf "%03i%03i%03i%03i", split( /\./, $ipv4_address);
     935
     936      my $mac_sort = sprintf "%04i-%s", 9999, $mac_address;
     937
     938
     939         my ( $host_short ) = sprintf "%s %3s" , split(/\./, $db_switch_parent{$sw}->{switch}, 1), $db_switch_parent{$sw}->{port};
     940
     941print <<END;
    956942  <tr class="$typerow">
    957943   <td sorttable_customkey="$switch_hostname_sort">$sw</td>
     
    963949   <td>$date</td>
    964950  </tr>
    965 END_HTML
     951END
    966952         }
    967953      else {
    968          print <<"END_HTML";
     954#         printf "%-25s  %2s  +-->  router\n", $sw, $db_switch_output_port{$sw};
     955print <<END;
    969956  <tr class="$typerow">
    970957   <td sorttable_customkey="$switch_hostname_sort">$sw</td>
     
    976963   <td></td>
    977964  </tr>
    978 END_HTML
     965END
    979966         }
    980967      }
    981968
    982969   for my $swport (sort keys %db_switch_connected_on_port) {
    983       my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
     970      my ($sw_connect,$port_connect) = split ':', $swport;
    984971      for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
    985972
    986          my $switch_hostname_sort = sprintf '%s %3s' ,$sw_connect, $port_connect;
     973         my $switch_hostname_sort = sprintf "%s %3s" ,$sw_connect, $port_connect;
    987974
    988975      my $mac_address = $db_switch{$sw}->{mac_address};
     
    993980      $year += 1900;
    994981      $mon++;
    995       my $date = sprintf '%04i-%02i-%02i %02i:%02i', $year,$mon,$mday,$hour,$min;
    996 
    997       my $ip_sort = sprintf '%03i%03i%03i%03i', split m/ \. /xms, $ipv4_address;
    998 
    999       my $mac_sort = sprintf '%04i-%s', 9999, $mac_address;
    1000 
    1001       $typerow = $typerow eq 'even' ? 'odd' : 'even';
     982      my $date = sprintf "%04i-%02i-%02i %02i:%02i", $year,$mon,$mday,$hour,$min;
     983
     984      my $ip_sort = sprintf "%03i%03i%03i%03i", split( /\./, $ipv4_address);
     985
     986      my $mac_sort = sprintf "%04i-%s", 9999, $mac_address;
     987
     988      $typerow = $typerow eq 'even' ? 'odd' : 'even'; 
    1002989
    1003990         if (exists $db_switch_output_port{$sw}) {
    1004991
    1005             my ( $host_short ) = sprintf '%s %3s' , split( m/\./xms, $sw, 1), $db_switch_output_port{$sw};
    1006 
    1007             print <<"END_HTML";
     992             my ( $host_short ) = sprintf "%s %3s" , split(/\./, $sw, 1), $db_switch_output_port{$sw};
     993
     994print <<END;
    1008995  <tr class="$typerow">
    1009996   <td sorttable_customkey="$switch_hostname_sort">$sw_connect</td>
     
    10151002   <td>$date</td>
    10161003  </tr>
    1017 END_HTML
     1004END
    10181005            }
    10191006         else {
    1020             print <<"END_HTML";
     1007print <<END;
    10211008  <tr class="$typerow">
    10221009   <td sorttable_customkey="$switch_hostname_sort">$sw_connect</td>
     
    10281015   <td>$date</td>
    10291016  </tr>
    1030 END_HTML
    1031             }
    1032          }
    1033       }
    1034 
    1035    print <<'END_HTML';
     1017END
     1018            }
     1019         }
     1020      }
     1021
     1022
     1023   print <<END;
    10361024 </tbody>
    10371025</table>
    1038 END_HTML
    1039    return;
     1026END
    10401027   }
    10411028
     
    10441031
    10451032   LOOP_ON_IP_ADDRESS:
    1046    foreach my $ip (Net::Netmask::sort_by_ip_address(keys %{$computerdb})) {
     1033   foreach my $ip (Net::Netmask::sort_by_ip_address(keys %$computerdb)) {
    10471034
    10481035      next LOOP_ON_IP_ADDRESS if $computerdb->{$ip}{hostname_fq} eq ($computerdb->{$ip}{switch_hostname} || $computerdb->{$ip}{switch_description}); # switch on himself !
    10491036
    1050       my $sw_hostname = $computerdb->{$ip}{switch_hostname} || q{};
     1037      my $sw_hostname = $computerdb->{$ip}{switch_hostname} || '';
    10511038      next if $sw_hostname eq 'unknow';
    1052 
    1053       my $sw_location = q{};
     1039 
     1040      my $sw_location = '';
    10541041      for my $sw (@SWITCH) {
    10551042         next if $sw_hostname ne $sw->{hostname};
     
    10581045         }
    10591046
    1060       printf "%s: \"%s\"\n", $ip, $sw_location if not $sw_location eq q{};
    1061       }
    1062    return;
     1047      printf "%s: \"%s\"\n", $ip, $sw_location if not $sw_location eq '';
     1048      }
    10631049   }
    10641050
     
    10661052   my $switch = shift;
    10671053   my $port   = shift;
    1068 
    1069    #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 1 (up)
    1070    #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 2 (down)
     1054   
     1055   #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 1 (up) 
     1056   #snmpset -v 1 -c community X.X.X.X 1.3.6.1.2.1.2.2.1.7.NoPort = 2 (down) 
    10711057   system "snmpset -v 1 -c public $switch 1.3.6.1.2.1.2.2.1.7.$port = 1";
    1072    return;
    10731058   }
    10741059
     
    10761061   my $switch = shift;
    10771062   my $port   = shift;
    1078 
     1063   
    10791064   system "snmpset -v 1 -c public $switch 1.3.6.1.2.1.2.2.1.7.$port = 2";
    1080    return;
    10811065   }
    10821066
     
    10841068   my $switch = shift;
    10851069   my $port   = shift;
    1086 
     1070   
    10871071   system "snmpget -v 1 -c public $switch 1.3.6.1.2.1.2.2.1.7.$port";
    1088    return;
    10891072   }
    10901073
    10911074sub cmd_search_mac_on_switch {
    1092    my $switch_name = shift || q{};
    1093    my $mac_address = shift || q{};
    1094 
    1095    if ($switch_name eq q{} or $mac_address eq q{}) {
     1075   my $switch_name = shift || '';
     1076   my $mac_address = shift || '';
     1077   
     1078   if ($switch_name eq '' or $mac_address eq '') {
    10961079      die "Usage: klask search-mac-on-switch SWITCH_NAME MAC_ADDRESS\n";
    10971080      }
    10981081
    10991082   if (not defined $SWITCH_DB{$switch_name}) {
    1100       die "Switch $switch_name must be defined in klask configuration file\n";
     1083      die "Switch $switch_name must be defined in klask configuration file\n"; 
    11011084      }
    11021085
     
    11051088      $session{-version} = $sw->{version}   || 1;
    11061089      $session{-port}    = $sw->{snmpport}  || $DEFAULT{snmpport}  || 161;
    1107    if (exists $sw->{version} and $sw->{version} eq '3') {
     1090   if (exists $sw->{version} and $sw->{version} eq 3) {
    11081091      $session{-username} = $sw->{username} || 'snmpadmin';
    11091092      }
     
    11121095      }
    11131096
    1114    my $research = '1.3.6.1.2.1.17.4.3.1.2' . arp_hex_to_dec($mac_address);
     1097   my $research = "1.3.6.1.2.1.17.4.3.1.2".arp_hex_to_dec($mac_address);
    11151098   print "Klask search OID $research on switch $switch_name\n";
    11161099
     
    11211104      -varbindlist => [$research]
    11221105      );
    1123 
    1124    if (not defined $result or $result->{$research} eq 'noSuchInstance') {
     1106   
     1107   if (not defined($result) or $result->{$research} eq 'noSuchInstance') {
    11251108      print "Klask do not find MAC $mac_address on switch $switch_name\n";
    11261109      $session->close;
     
    11311114
    11321115   print "Klask find MAC $mac_address on switch $switch_name port $swport\n";
    1133    return;
    11341116   }
    11351117
     
    11461128#   for my $one_computer ('194.254.66.254') {
    11471129   for my $one_router ( get_list_main_router(get_list_network()) ) {
    1148       my %resol_arp = resolve_ip_arp_host($one_router, q{*}, q{low}); # resolution arp
     1130#print "TT$one_router\n";     
     1131      my %resol_arp = resolve_ip_arp_host($one_router,'*','low');            # resolution arp
    11491132      next DETECT_ALL_ROUTER if $resol_arp{mac_address} eq 'unknow';
     1133#print "$one_router\n";     
    11501134      $where{$resol_arp{ipv4_address}} = find_all_switch_port($resol_arp{mac_address}); # retrouve les emplacements des routeurs
    11511135      }
     
    11531137   ALL_ROUTER_IP_ADDRESS:
    11541138   for my $ip (Net::Netmask::sort_by_ip_address(keys %where)) { # '194.254.66.254')) {
    1155 
     1139   
    11561140      next ALL_ROUTER_IP_ADDRESS if not exists $where{$ip}; # /a priori/ idiot car ne sers à rien...
    11571141
     
    11621146
    11631147         next ALL_SWITCH_CONNECTED if $switch->{port} eq '0';
    1164 
     1148         
    11651149         $db_switch_output_port{$switch->{hostname}} = $switch->{port};
    11661150         }
    1167       }
     1151      }   
     1152
     1153#   print "Switch output port\n"; 
     1154#   print "------------------\n";
     1155#   for my $sw (sort keys %db_switch_output_port) {
     1156#      printf "%-25s %2s\n", $sw, $db_switch_output_port{$sw};
     1157#      }
     1158#   print "\n";
     1159
    11681160
    11691161   my %db_switch_link_with = ();
     
    11791171   ALL_SWITCH:
    11801172   for my $one_computer (@list_switch_ip) {
    1181       my %resol_arp = resolve_ip_arp_host($one_computer, q{*}, q{low}); # arp resolution
     1173      my %resol_arp = resolve_ip_arp_host($one_computer,'*','low'); # arp resolution
    11821174      next ALL_SWITCH if $resol_arp{mac_address} eq 'unknow';
    1183 
     1175     
    11841176      push @list_switch_ipv4,$resol_arp{ipv4_address};
    1185 
     1177     
    11861178      $where{$resol_arp{ipv4_address}} = find_all_switch_port($resol_arp{mac_address}); # find port on all switch
    11871179
     
    11921184      $SWITCH_DB{$one_computer}->{timestamp}    = $timestamp;
    11931185      }
    1194 
     1186     
    11951187   ALL_SWITCH_IP_ADDRESS:
    11961188   for my $ip (Net::Netmask::sort_by_ip_address(@list_switch_ipv4)) {
    1197 
     1189   
    11981190      next ALL_SWITCH_IP_ADDRESS if not exists $where{$ip};
    11991191
     
    12141206
    12151207      }
    1216 
     1208   
    12171209   my %db_switch_connected_on_port = ();
    12181210   my $maybe_more_than_one_switch_connected = 'yes';
    1219 
     1211   
    12201212   while ($maybe_more_than_one_switch_connected eq 'yes') {
    12211213      for my $sw (keys %db_switch_link_with) {
    12221214         for my $connect (keys %{$db_switch_link_with{$sw}}) {
    1223 
     1215         
    12241216            my $port = $db_switch_link_with{$sw}->{$connect};
    1225 
     1217         
    12261218            $db_switch_connected_on_port{"$connect:$port"} ||= {};
    12271219            $db_switch_connected_on_port{"$connect:$port"}->{$sw}++; # Just to define the key
     
    12331225      SWITCH_AND_PORT:
    12341226      for my $swport (keys %db_switch_connected_on_port) {
    1235 
     1227         
    12361228         next if keys %{$db_switch_connected_on_port{$swport}} == 1;
    1237 
     1229         
    12381230         $maybe_more_than_one_switch_connected = 'yes';
    12391231
    1240          my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
     1232         my ($sw_connect,$port_connect) = split ':', $swport;
    12411233         my @sw_on_same_port = keys %{$db_switch_connected_on_port{$swport}};
    12421234
    12431235         CONNECTED:
    12441236         for my $sw_connected (@sw_on_same_port) {
    1245 
     1237           
    12461238            next CONNECTED if not keys %{$db_switch_link_with{$sw_connected}} == 1;
    1247 
     1239           
    12481240            $db_switch_connected_on_port{$swport} = {$sw_connected => 1};
    1249 
     1241           
    12501242            for my $other_sw (@sw_on_same_port) {
    12511243               next if $other_sw eq $sw_connected;
    1252 
     1244               
    12531245               delete $db_switch_link_with{$other_sw}->{$sw_connect};
    12541246               }
    1255 
     1247           
    12561248            # We can not do better for this switch for this loop
    12571249            next SWITCH_AND_PORT;
     
    12641256   for my $sw (keys %db_switch_link_with) {
    12651257      for my $connect (keys %{$db_switch_link_with{$sw}}) {
    1266 
     1258     
    12671259         my $port = $db_switch_link_with{$sw}->{$connect};
    1268 
     1260     
    12691261         $db_switch_connected_on_port{"$connect:$port"} ||= {};
    12701262         $db_switch_connected_on_port{"$connect:$port"}->{$sw} = $port;
    1271 
     1263       
    12721264         $db_switch_parent{$sw} = {switch => $connect, port => $port};
    12731265         }
    12741266      }
    12751267
    1276    print "Switch output port and parent port connection\n";
     1268   print "Switch output port and parent port connection\n"; 
    12771269   print "---------------------------------------------\n";
    12781270   for my $sw (sort keys %db_switch_output_port) {
     
    12881280   print "Switch parent and children port inter-connection\n";
    12891281   print "------------------------------------------------\n";
    1290    for my $swport (sort keys %db_switch_connected_on_port) {
    1291       my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
     1282   for my $swport (sort keys %db_switch_connected_on_port) {       
     1283      my ($sw_connect,$port_connect) = split ':', $swport;
    12921284      for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
    12931285         if (exists $db_switch_output_port{$sw}) {
     
    13071299      switch_db         => \%SWITCH_DB,
    13081300      };
    1309 
     1301     
    13101302   YAML::Syck::DumpFile("$KLASK_SW_FILE", $switch_connection);
    1311    return;
    13121303   }
    13131304
     
    13291320
    13301321   $format = 'txt' if not defined $possible_format{$format};
    1331 
     1322   
    13321323   $possible_format{$format}->(@ARGV);
    1333    return;
    13341324   }
    13351325
     
    13421332   my %db_switch_connected_on_port = %{$switch_connection->{connected_on_port}};
    13431333
    1344    print "Switch output port and parent port connection\n";
     1334   print "Switch output port and parent port connection\n"; 
    13451335   print "---------------------------------------------\n";
    13461336   for my $sw (sort keys %db_switch_output_port) {
     
    13561346   print "Switch parent and children port inter-connection\n";
    13571347   print "------------------------------------------------\n";
    1358    for my $swport (sort keys %db_switch_connected_on_port) {
    1359       my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
     1348   for my $swport (sort keys %db_switch_connected_on_port) {       
     1349      my ($sw_connect,$port_connect) = split ':', $swport;
    13601350      for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
    13611351         if (exists $db_switch_output_port{$sw}) {
     
    13671357         }
    13681358      }
    1369    return;
    13701359   }
    13711360
     
    13731362
    13741363   my $switch_connection = YAML::Syck::LoadFile("$KLASK_SW_FILE");
    1375 
     1364   
    13761365   my %db_switch_output_port       = %{$switch_connection->{output_port}};
    13771366   my %db_switch_parent            = %{$switch_connection->{parent}};
     
    13821371   my %db_building= ();
    13831372   for my $sw (@SWITCH) {
    1384       my ($building, $location) = split m/ \/ /xms, $sw->{location}, 2;
     1373      my ($building, $location) = split /\//, $sw->{location}, 2;
    13851374      $db_building{$building} ||= {};
    13861375      $db_building{$building}->{$location} ||= {};
    13871376      $db_building{$building}->{$location}{ $sw->{hostname} } = 'y';
    13881377      }
    1389 
    1390 
     1378 
     1379 
    13911380   print "digraph G {\n";
    13921381
     
    13971386   for my $building (keys %db_building) {
    13981387      $b++;
    1399 
     1388     
    14001389      print "\"building$b\" [label = \"$building\", color = black, fillcolor = gold, style = filled];\n";
    14011390      print "site -> \"building$b\" [len = 2, color = firebrick];\n";
     
    14041393      for my $loc (keys %{$db_building{$building}}) {
    14051394         $l++;
    1406 
    1407          print "\"location$b-$l\" [label = \"$building" . q{/} . join(q{\n}, split(m{ / }xms, $loc)) . "\", color = black, fillcolor = orange, style = filled];\n";
     1395 
     1396         print "\"location$b-$l\" [label = \"$building".'/'.join('\n',split("/",$loc))."\", color = black, fillcolor = orange, style = filled];\n";
    14081397#         print "\"location$b-$l\" [label = \"$building / $loc\", color = black, fillcolor = orange, style = filled];\n";
    14091398         print "\"building$b\" -> \"location$b-$l\" [len = 2, color = firebrick]\n";
     
    14141403
    14151404            my $swname  = $sw;
    1416                $swname .= q{\n-\n} . "$db_switch_global{$sw}->{model}" if exists $db_switch_global{$sw} and exists $db_switch_global{$sw}->{model};
     1405               $swname .= '\n-\n'."$db_switch_global{$sw}->{model}" if exists $db_switch_global{$sw} and exists $db_switch_global{$sw}->{model};
    14171406            print "\"$sw\" [label = \"$swname\", color = black, fillcolor = palegreen, shape = rect, style = filled];\n";
    14181407            print "\"location$b-$l\" -> \"$sw\" [len = 2, color = firebrick, arrowtail = dot]\n";
     
    14211410
    14221411            for my $swport (keys %db_switch_connected_on_port) {
    1423                my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
     1412               my ($sw_connect,$port_connect) = split ':', $swport;
    14241413               next if not $sw_connect eq $sw;
    14251414               next if $port_connect eq $db_switch_output_port{$sw};
     
    14311420      }
    14321421
    1433 #   print "Switch output port and parent port connection\n";
     1422#   print "Switch output port and parent port connection\n"; 
    14341423#   print "---------------------------------------------\n";
    14351424   for my $sw (sort keys %db_switch_output_port) {
     
    14451434#   print "Switch parent and children port inter-connection\n";
    14461435#   print "------------------------------------------------\n";
    1447    for my $swport (sort keys %db_switch_connected_on_port) {
    1448       my ($sw_connect,$port_connect) = split m/ : /xms, $swport;
     1436   for my $swport (sort keys %db_switch_connected_on_port) {       
     1437      my ($sw_connect,$port_connect) = split ':', $swport;
    14491438      for my $sw (keys %{$db_switch_connected_on_port{$swport}}) {
    14501439         if (exists $db_switch_output_port{$sw}) {
     
    14581447
    14591448print "}\n";
    1460    return;
    14611449   }
    14621450
     
    14691457
    14701458
    1471 =head1 USAGE
     1459=head1 SYNOPSIS
    14721460
    14731461 klask updatedb
     
    16031591
    16041592
    1605 =head1 LICENSE AND COPYRIGHT
     1593=head1 COPYRIGHT
     1594       
     1595Copyright (C) 2005-2008 Gabriel Moreau.
     1596
     1597
     1598=head1 LICENCE
    16061599
    16071600GPL version 2 or later and Perl equivalent
    16081601
    1609 Copyright (C) 2005-2009 Gabriel Moreau.
Note: See TracChangeset for help on using the changeset viewer.