| 1 |
package ip; |
| 2 |
|
| 3 |
use warnings; |
| 4 |
use strict; |
| 5 |
|
| 6 |
use Data::Dump qw/dump/; |
| 7 |
|
| 8 |
use html; |
| 9 |
use server; |
| 10 |
|
| 11 |
sub lines { |
| 12 |
my ( $object ) = @_; |
| 13 |
|
| 14 |
my $debug = server::debug(); |
| 15 |
|
| 16 |
$object ||= 'link'; |
| 17 |
|
| 18 |
my $i = 0; |
| 19 |
my @objects; |
| 20 |
|
| 21 |
my @headers; |
| 22 |
my $headers; |
| 23 |
|
| 24 |
foreach my $line ( split(/\n/, `ip $object`) ) { |
| 25 |
warn "# $line\n" if $debug; |
| 26 |
my $add_header; |
| 27 |
|
| 28 |
if ( $line =~ s{^(\d+):\s+(\w+):\s+}{} ) { |
| 29 |
$i = $1; |
| 30 |
$objects[$i] = { dev => $2 }; |
| 31 |
$add_header = $object; |
| 32 |
} elsif ( $line =~ s{^\s+}{} ) { |
| 33 |
# line continues |
| 34 |
} else { |
| 35 |
$i++; |
| 36 |
$line =~ s{^(\S+)\s+}{}; |
| 37 |
$objects[$i] = { |
| 38 |
$object => $1 |
| 39 |
}; |
| 40 |
$add_header = $object; |
| 41 |
} |
| 42 |
|
| 43 |
push @headers, $add_header if $add_header && ! $headers->{$add_header}++; |
| 44 |
|
| 45 |
if ( $line =~ s{<(\S+)>\s+}{} ) { |
| 46 |
$add_header = 'flags'; |
| 47 |
$objects[$i]->{$add_header} = $1; |
| 48 |
push @headers, $add_header unless $headers->{$add_header}++; |
| 49 |
} |
| 50 |
|
| 51 |
my @p = split(/\s+/, $line); |
| 52 |
while (@p) { |
| 53 |
my ($n,$v) = splice @p, 0, 2; |
| 54 |
if ( ! defined $v ) { |
| 55 |
$objects[$i]->{''} = $n; |
| 56 |
$n = ''; |
| 57 |
} elsif ( $n =~ m{^(.+)/(.+)$} ) { |
| 58 |
$n = $1; |
| 59 |
$objects[$i]->{$n} = $2; |
| 60 |
$objects[$i]->{mac} = $v; |
| 61 |
} else { |
| 62 |
$objects[$i]->{$n} = $v; |
| 63 |
} |
| 64 |
push @headers, $n unless $headers->{$n}++; |
| 65 |
} |
| 66 |
|
| 67 |
# warn dump( $objects[$i] ); |
| 68 |
} |
| 69 |
|
| 70 |
return unless @objects; |
| 71 |
|
| 72 |
$objects[0] = [ @headers ]; |
| 73 |
|
| 74 |
return @objects; |
| 75 |
} |
| 76 |
|
| 77 |
sub html { |
| 78 |
my @objects = ip::lines( @_ ); |
| 79 |
return '' unless @objects; |
| 80 |
|
| 81 |
my @headers = @{ shift @objects }; |
| 82 |
|
| 83 |
my @table = ( -( $#headers + 1), @headers ); |
| 84 |
foreach my $o ( @objects ) { |
| 85 |
foreach ( 0 .. $#headers ) { |
| 86 |
my $h = $headers[$_]; |
| 87 |
push @table, $o->{$h}; |
| 88 |
} |
| 89 |
} |
| 90 |
|
| 91 |
return html::table( @table ); |
| 92 |
} |
| 93 |
|
| 94 |
sub devices_up { |
| 95 |
my @links = ip::lines( 'link' ); |
| 96 |
my @devs; |
| 97 |
foreach ( 1 .. $#links ) { |
| 98 |
push @devs, $links[$_]->{dev} if $links[$_]->{flags} =~ m{UP}; |
| 99 |
} |
| 100 |
return @devs; |
| 101 |
} |
| 102 |
|
| 103 |
sub default_route_dev { |
| 104 |
my @routes = ip::lines 'route'; |
| 105 |
|
| 106 |
return |
| 107 |
map { $_->{dev} } |
| 108 |
grep { $_->{route} eq 'default' } |
| 109 |
splice @routes, 1 # FIXME ship header |
| 110 |
; |
| 111 |
} |
| 112 |
|
| 113 |
sub to_int { |
| 114 |
unpack( 'N', pack( 'C*', split(/\./, shift) ) ) |
| 115 |
} |
| 116 |
|
| 117 |
sub from_int { |
| 118 |
join( '.', unpack('C4', pack('N',shift)) ) |
| 119 |
} |
| 120 |
|
| 121 |
sub in_dhcp_range { |
| 122 |
my $ip = shift; |
| 123 |
|
| 124 |
my $server = server::as_hash_for $ip; |
| 125 |
|
| 126 |
my $i = to_int($ip) & to_int($server->{netmask}); |
| 127 |
my $s = to_int($server->{ip}) & to_int($server->{netmask}); |
| 128 |
|
| 129 |
if ( $i == $s ) { |
| 130 |
$i = to_int($ip) & ( to_int($server->{netmask}) ^ 0xffffffff ); |
| 131 |
return 1 if ( $i >= $server->{ip_from} && $i <= $server->{ip_to} ); |
| 132 |
} |
| 133 |
return 0; |
| 134 |
} |
| 135 |
|
| 136 |
1; |
Parent Directory
| 
Revision Log