lib/PXElator/client.pm

package client;

use warnings;
use strict;
use autodie;

use File::Slurp;
use Data::Dump qw/dump/;
use File::Path;

use server;
use format;
use ip;
use ping;
use kvm;

our $debug = $server::debug;

sub mkbasedir {
        my $path = shift;
        $path =~ s{(^.*)/[^/]+$}{$1};
        mkdir $path unless -d $path;
        return $path;
}

sub mac_path { $server::conf . '/mac/' . $_[0] }
sub  ip_path { $server::conf . '/ip/'  . join('/', @_) }
sub conf_value {
        my $path = shift;
        my $value;
        if ( -l $path ) {
                $value = readlink $path;
                $value =~ s{.*/([^/]+)$}{$1};
        } elsif ( -f $path ) {
                $value = read_file $path;
        } else {
                warn "W: $path not file or symlink\n";
        }
        return $value;
}

sub conf {
        my $ip  = shift;
        my $name = shift;
        my ( $default, $value );
        if ( $#_ == 0 ) {
                $value = shift;
        } elsif ( $#_ == 1 && $_[0] eq 'default' ) {
                $default = $_[1]
        }

        my $path = ip_path $ip;
        mkdir $path unless -d $path;
        $path .= '/' . $name;

        if ( defined $value ) {
                mkbasedir  $path;
                write_file $path, $value;
                warn "update $path = $value";
        } elsif ( ! -e $path && defined $default ) {
                mkbasedir  $path;
                write_file $path, $default;
                warn "default $path = $default";
                $value = $default;
        } elsif ( -l $path ) {
                $value = readlink $path;
        } elsif ( -f $path ) {
                $value = read_file $path;
                chomp $value;
        } else {
                warn "# $name missing $path\n" if $debug;
        }
        return $value;
}

sub all_conf {
        my $ip = shift;
        my $path = ip_path $ip || return;
        my $conf;
        foreach my $file ( glob("$path/*"), glob("$path/*/*") ) {
                my $name = $file;
                $name =~ s{^$path/+}{} || die "can't remove $path from $name";
                $conf->{ $name } =
                        -l $file ? readlink  $file :
                        -f $file ? read_file $file :
                        '?';
        }
        return $conf;
}
sub next_ip($) {
        my $mac = shift;
        $mac = format::mac($mac);

        if ( $server::new_clients > 0 ) {
                warn "# clients left: ", --$server::new_clients;
        } else {
                warn "W: no new clients accepted";
                return '0.0.0.0';
        }

        my $prefix = $server::ip;
        $prefix =~ s{\.\d+$}{.};
        my $addr = $server::ip_from || die;
        my $ip = $prefix . $addr;

        while ( -e ip_path($ip) || ping::host($ip) ) {
                $ip = $prefix . $addr++;
                die "all addresses allocated!" if $addr == $server::ip_to;
                warn "skip $ip\n";
        }

        warn "next_ip $ip\n";

        save_ip_mac( $ip, $mac );

        return $ip;
}

sub save_ip_mac {
        my ($ip,$mac) = @_;
        $mac = format::mac($mac);
        return if $mac eq '00:00:00:00:00:00' || $ip eq '0.0.0.0';

        mkdir ip_path($ip) unless -e ip_path($ip);

        my $mac_path = mac_path($mac);
        unlink $mac_path if -l $mac_path;       # XXX audit?
        symlink ip_path($ip), $mac_path;
        write_file( ip_path($ip,'mac'), $mac );
}

sub ip_from_mac($) {
        my $mac = shift;
        $mac = format::mac($mac);

        my $mac_path = mac_path $mac;
        return unless -e $mac_path;

        my $ip;

        if ( -f $mac_path ) {
                $ip = read_file $mac_path;
                unlink $mac_path;
                symlink ip_path($ip), $mac_path;
                warn "I: upgrade to mac symlink $mac_path\n";
        } elsif ( -l $mac_path ) {
                $ip = conf_value $mac_path;
        } else {
                die "$mac_path not file or symlink";
        }

        return $ip;
}

sub mac_from_ip($) {
        my $ip = shift;
        conf_value ip_path($ip, 'mac');
}

sub change_ip($$) {
        my ($old, $new) = @_;
        return if $old eq $new;
        my $mac = mac_from_ip($old) || die "no mac for $old";
        rename ip_path($old), ip_path($new);
        unlink mac_path($mac);
        symlink ip_path($new), mac_path($mac);
        return $new;
}

sub all_ips {
        sort { ip::to_int($a) cmp ip::to_int($b) }
        map {
                my $ip = $_;
                $ip =~ s{^.+/ip/}{};
                autocreate_params( $ip );
                $ip;
        } glob("$server::conf/ip/*") 
}

sub remove {
        my $ip = shift;
        if ( my $mac = mac_from_ip $ip ) {
                unlink "$server::conf/mac/$mac";
        }
        rmtree "$server::conf/ip/$ip";
}

sub arp_mac_dev {
        my $arp = {
                map {
                        my @c = split(/\s+/,$_);
                        if ( $#c == 5 ) {
                                client::save_ip_mac( $c[0], $c[3] );
                                ( uc $c[3] => $c[5] )
                        } else {
                        }
                } read_file('/proc/net/arp')
        };

        warn "# arp ",dump( $arp );
        return $arp;
}

sub rebuild_mac_links {
        warn "# rebuild mac links";
        foreach my $ip ( all_ips ) {
                my $mac = ip_path $ip, 'mac';
                if ( -e $mac ) {
                        $mac = read_file $mac;
                        chomp $mac;
                        save_ip_mac( $ip, $mac );
                        warn "## $ip $mac\n";
                }
        }
}

sub autocreate_params {
        my $ip = shift;
        my $mac = mac_from_ip $ip;
        if ( $mac =~ m{^AC:DE:48:00:00} && ! defined conf( $ip, 'kvm' ) ) {
                conf( $ip, 'kvm', default => kvm::nr_from_mac( $mac ) );
                warn "# create kvm for $ip";
        }
}

1;
1	package client;
2
3	use warnings;
4	use strict;
5	use autodie;
6
7	use File::Slurp;
8	use Data::Dump qw/dump/;
9	use File::Path;
10
11	use server;
12	use format;
13	use ip;
14	use ping;
15	use kvm;
16
17	our $debug = $server::debug;
18
19	sub mkbasedir {
20	my $path = shift;
21	$path =~ s{(^.*)/[^/]+$}{$1};
22	mkdir $path unless -d $path;
23	return $path;
24	}
25
26	sub mac_path { $server::conf . '/mac/' . $_[0] }
27	sub ip_path { $server::conf . '/ip/' . join('/', @_) }
28	sub conf_value {
29	my $path = shift;
30	my $value;
31	if ( -l $path ) {
32	$value = readlink $path;
33	$value =~ s{.*/([^/]+)$}{$1};
34	} elsif ( -f $path ) {
35	$value = read_file $path;
36	} else {
37	warn "W: $path not file or symlink\n";
38	}
39	return $value;
40	}
41
42	sub conf {
43	my $ip = shift;
44	my $name = shift;
45	my ( $default, $value );
46	if ( $#_ == 0 ) {
47	$value = shift;
48	} elsif ( $#_ == 1 && $_[0] eq 'default' ) {
49	$default = $_[1]
50	}
51
52	my $path = ip_path $ip;
53	mkdir $path unless -d $path;
54	$path .= '/' . $name;
55
56	if ( defined $value ) {
57	mkbasedir $path;
58	write_file $path, $value;
59	warn "update $path = $value";
60	} elsif ( ! -e $path && defined $default ) {
61	mkbasedir $path;
62	write_file $path, $default;
63	warn "default $path = $default";
64	$value = $default;
65	} elsif ( -l $path ) {
66	$value = readlink $path;
67	} elsif ( -f $path ) {
68	$value = read_file $path;
69	chomp $value;
70	} else {
71	warn "# $name missing $path\n" if $debug;
72	}
73	return $value;
74	}
75
76	sub all_conf {
77	my $ip = shift;
78	my $path = ip_path $ip \|\| return;
79	my $conf;
80	foreach my $file ( glob("$path/"), glob("$path//*") ) {
81	my $name = $file;
82	$name =~ s{^$path/+}{} \|\| die "can't remove $path from $name";
83	$conf->{ $name } =
84	-l $file ? readlink $file :
85	-f $file ? read_file $file :
86	'?';
87	}
88	return $conf;
89	}
90	sub next_ip($) {
91	my $mac = shift;
92	$mac = format::mac($mac);
93
94	if ( $server::new_clients > 0 ) {
95	warn "# clients left: ", --$server::new_clients;
96	} else {
97	warn "W: no new clients accepted";
98	return '0.0.0.0';
99	}
100
101	my $prefix = $server::ip;
102	$prefix =~ s{\.\d+$}{.};
103	my $addr = $server::ip_from \|\| die;
104	my $ip = $prefix . $addr;
105
106	while ( -e ip_path($ip) \|\| ping::host($ip) ) {
107	$ip = $prefix . $addr++;
108	die "all addresses allocated!" if $addr == $server::ip_to;
109	warn "skip $ip\n";
110	}
111
112	warn "next_ip $ip\n";
113
114	save_ip_mac( $ip, $mac );
115
116	return $ip;
117	}
118
119	sub save_ip_mac {
120	my ($ip,$mac) = @_;
121	$mac = format::mac($mac);
122	return if $mac eq '00:00:00:00:00:00' \|\| $ip eq '0.0.0.0';
123
124	mkdir ip_path($ip) unless -e ip_path($ip);
125
126	my $mac_path = mac_path($mac);
127	unlink $mac_path if -l $mac_path; # XXX audit?
128	symlink ip_path($ip), $mac_path;
129	write_file( ip_path($ip,'mac'), $mac );
130	}
131
132	sub ip_from_mac($) {
133	my $mac = shift;
134	$mac = format::mac($mac);
135
136	my $mac_path = mac_path $mac;
137	return unless -e $mac_path;
138
139	my $ip;
140
141	if ( -f $mac_path ) {
142	$ip = read_file $mac_path;
143	unlink $mac_path;
144	symlink ip_path($ip), $mac_path;
145	warn "I: upgrade to mac symlink $mac_path\n";
146	} elsif ( -l $mac_path ) {
147	$ip = conf_value $mac_path;
148	} else {
149	die "$mac_path not file or symlink";
150	}
151
152	return $ip;
153	}
154
155	sub mac_from_ip($) {
156	my $ip = shift;
157	conf_value ip_path($ip, 'mac');
158	}
159
160	sub change_ip($$) {
161	my ($old, $new) = @_;
162	return if $old eq $new;
163	my $mac = mac_from_ip($old) \|\| die "no mac for $old";
164	rename ip_path($old), ip_path($new);
165	unlink mac_path($mac);
166	symlink ip_path($new), mac_path($mac);
167	return $new;
168	}
169
170	sub all_ips {
171	sort { ip::to_int($a) cmp ip::to_int($b) }
172	map {
173	my $ip = $_;
174	$ip =~ s{^.+/ip/}{};
175	autocreate_params( $ip );
176	$ip;
177	} glob("$server::conf/ip/*")
178	}
179
180	sub remove {
181	my $ip = shift;
182	if ( my $mac = mac_from_ip $ip ) {
183	unlink "$server::conf/mac/$mac";
184	}
185	rmtree "$server::conf/ip/$ip";
186	}
187
188	sub arp_mac_dev {
189	my $arp = {
190	map {
191	my @c = split(/\s+/,$_);
192	if ( $#c == 5 ) {
193	client::save_ip_mac( $c[0], $c[3] );
194	( uc $c[3] => $c[5] )
195	} else {
196	}
197	} read_file('/proc/net/arp')
198	};
199
200	warn "# arp ",dump( $arp );
201	return $arp;
202	}
203
204	sub rebuild_mac_links {
205	warn "# rebuild mac links";
206	foreach my $ip ( all_ips ) {
207	my $mac = ip_path $ip, 'mac';
208	if ( -e $mac ) {
209	$mac = read_file $mac;
210	chomp $mac;
211	save_ip_mac( $ip, $mac );
212	warn "## $ip $mac\n";
213	}
214	}
215	}
216
217	sub autocreate_params {
218	my $ip = shift;
219	my $mac = mac_from_ip $ip;
220	if ( $mac =~ m{^AC:DE:48:00:00} && ! defined conf( $ip, 'kvm' ) ) {
221	conf( $ip, 'kvm', default => kvm::nr_from_mac( $mac ) );
222	warn "# create kvm for $ip";
223	}
224	}
225
226	1;