source: fedkit/gateway_lib.pm @ 8f654de

Last change on this file since 8f654de was 8f654de, checked in by Ted Faber <faber@…>, 6 years ago

More formatting tweaks for Linux

  • Property mode set to 100644
File size: 11.6 KB
Line 
1#!/usr/bin/perl
2
3package gateway_lib;
4
5# Package stuff to keep the caller's namespace clean, but allow additions if
6# they need it.
7require Exporter;
8@ISA=qw(Exporter);
9@EXPORT_OK=qw(set_sshd_params import_key wait_for_DNS deter_tunnelip
10    configure_outgoing_iface add_route bind_tap_to_iface iface_to_addr
11    dest_to_iface addr_to_iface read_config config_filename);
12
13
14use strict;
15
16use IO::File;
17use IO::Pipe;
18use IO::Socket;
19
20use File::Temp;
21use File::Copy;
22use Net::hostent;
23
24# Standard locations of these commands (FreeBSD)
25my $IFCONFIG = "/sbin/ifconfig";
26my $ROUTE = "/sbin/route";
27my $TMCC = "/usr/local/etc/emulab/tmcc";
28my $FINDIF = "/usr/local/etc/emulab/findif";
29my $TMCC = "/usr/local/etc/emulab/tmcc";
30
31# Linux choices
32my $BRCTL = "/usr/sbin/brctl";
33my $IPROUTE = "/sbin/ip route ";
34
35$BRCTL = '/sbin/brctl' unless -x $BRCTL ;
36
37# Takes an ssh config file and a reference to a hash of keys whose values must
38# be set a specific way.  Replaces existing entries with the set values.
39sub set_sshd_params {
40    my($keys, $file) = @_;
41    my $f;
42    my $t;
43
44    $file = "/etc/ssh/sshd_config" unless $file;
45    $f = new IO::File("$file") || die "Can't read $f: $!\n";
46    $t = new File::Temp() || die "Can't open tempfile: $!\n";
47
48    # If the parameter is in the file (even in a comment) update the line to
49    # have the new parameter.
50    my %updated;
51    while (<$f>) {
52        foreach my $k (keys %{$keys}) {
53            if (s/^\s*#?\s*$k.*/$k $keys->{$k}/) { $updated{$k}++; }
54        }
55        print $t $_;
56    }
57    # Any parameters not found above are output directly.
58    foreach my $k (keys %{$keys}) {
59        print $t "$k " . $keys->{$k} . "\n" unless $updated{$k};
60    }
61    $f->close();
62    $t->close();
63    copy("$file", "$file.hold");
64    copy($t->filename, $file);
65    # When $t goes out of scope, the tmpfile is deleted
66}
67
68# Append the given keyfile to the given authorised key file.
69sub import_key {
70    my($keyfile, $authkeys) = @_;
71
72    my $kf = new IO::File($keyfile) || die "Can't open $keyfile:$!\n";
73    my $ak = new IO::File(">>$authkeys") || die "Can't open $authkeys: $!\n";
74
75    while (<$kf>) {
76        print $ak $_;
77    }
78    $kf->close();
79    $ak->close();
80}
81
82# Keep trying to look up the given hostname until successful.  If timeout is
83# given, die after waiting that long.  If sleep is given, wait that many
84# seconds between attempts (defaults to 5). 
85sub wait_for_DNS {
86    my($name, $timeout, $sleep) = @_;
87    my $start = time();
88    $sleep = 5 unless $sleep;
89    my $rv;
90
91    # If the name is an IP address, skip this.
92    return if $name =~ /^[\d\.]+$/;
93
94    while (!$rv) {
95        $rv = gethostbyname($name);
96        die "Timeout waiting for DNS to get $name\n" 
97            if ($timeout && time() - $start > $timeout);
98        sleep($sleep) unless $rv;
99    }
100}
101
102# Get the external access parameters (interface, address, netmask, mac address,
103# and next hop router) from tmcd in Emulabs that support the DETER tunnelip
104# extension.
105sub deter_tunnelip {
106    # To parse tmcc
107    my $tmcc = new IO::Pipe || die "Can't create tmcc pipe: $!\n";
108    my $interface;              # Interface with external address
109    my $ip;                     # IP address of external interface
110    my $mac;                    # MAC address
111    my $netmask;                # Netmask
112    my $router;                 # Router for the internet
113
114
115    # Parse out the info about tunnelips.  Format is usually one line of
116    # ATTR=VALUE.  Multiple lines are possible.
117    $tmcc->reader("$TMCC tunnelip");
118    while (<$tmcc>) {
119        chomp;
120        /TUNNELIP=([\d\.]*)/ && do { $ip = $1; };
121        /TUNNELMASK=([\d\.]*)/ && do { $netmask = $1; };
122        /TUNNELMAC=([[:xdigit:]]*)/ && do { $mac = $1; };
123        /TUNNELROUTER=([\d\.]*)/ && do { $router = $1; };
124    }
125    $tmcc->close();
126
127    die "No MAC information for tunnel.\n" unless $mac;
128
129    # Use the emulab findif command to get the right interface to configure
130    $interface = `$FINDIF $mac`;
131    chomp $interface;
132    die "Can't get interface for mac address $mac: $?" if $? || !$interface;
133
134    return ($interface, $ip, $netmask, $mac, $router);
135}
136
137
138# Configure the given interface with the given IP address and netmask.
139sub configure_outgoing_iface {
140    my ($interface, $ip, $netmask) = @_;
141
142    my @ifconfig = ($IFCONFIG, $interface, $ip);
143    push(@ifconfig, 'netmask', $netmask) if $netmask;
144
145    system(@ifconfig);
146    die join(" ", @ifconfig) . " failed: $!\n" if $?;
147}
148
149# Add a route to the destination through the router.  If wait is given, do not
150# attempt to add the route until DNS has the hostname in it.  If timeout is
151# given, only wait that many seconds for DNS to acquire it.
152sub add_route {
153    my($routedest, $router, $wait, $timeout) = @_;
154    my @cmd;
155    # Linux and FreeBSD use slightly different route syntax, so get the OS
156    my $os = `uname`;
157    chomp $os;
158
159    $timeout = 0 unless $timeout;
160    die "add_host_route needs a router and a destination\n"
161        unless $router && $routedest;
162
163    wait_for_DNS($routedest, $timeout) if $wait;
164
165    if ( $os =~ /^Linux/ ) { 
166        @cmd = ($ROUTE, 'add', $routedest, 'gw', $router);
167    }
168    elsif ( $os =~ /^FreeBSD/ ) {
169        @cmd = ($ROUTE, 'add', $routedest, $router);
170    }
171    else {
172        die "Unknown OS: $os\n";
173    }
174    system(@cmd);
175    warn join(" ", @cmd) . " failed: $?\n" if $?;
176    return $?;
177}
178
179# Connect the tap($tapno) interface to $iface at the link level.  Remove any IP
180# addresses assigned to interface to avoid confusing the routing system.  We're
181# very tolerant of errors as the bridge and other interfaces may already exist
182# when this is called.
183sub bind_tap_to_iface {
184    my($tapno, $iface) = @_;
185    my $bridge = "bridge$tapno";
186    my $tap = "tap$tapno";
187    my @addr = iface_to_addr($iface);
188
189    # Wait for the tap
190    system("$IFCONFIG $tap > /dev/null 2>/dev/null");
191    while ($?) {
192        system("$IFCONFIG $tap > /dev/null 2>/dev/null");
193    }
194
195    my $uname = `uname`;
196    chomp $uname;
197
198    if ($uname =~ /FreeBSD/) {
199        system("ifconfig $bridge create");
200        warn "Cannot create bridge: $?\n" if $?;
201        foreach my $a (@addr) {
202            system("ifconfig $iface delete $a");
203            warn "Cannot delete address $a: $?\n" if $?;
204        }
205        system("ifconfig $bridge addm $iface up");
206        warn "Cannot add intefrace $iface to bridge: $?\n" if $?;
207        system("ifconfig $bridge addm $tap");
208        warn "Cannot add intefrace $tap to bridge: $?\n" if $?;
209        return $?;
210    }
211    elsif ($uname =~ /Linux/) {
212        system("$IFCONFIG $iface 0.0.0.0 down");
213        system("$BRCTL addbr $bridge");
214        warn "Cannot create bridge: $?\n" if $?;
215        system("$BRCTL addif $bridge $tap");
216        system("$BRCTL addif $bridge $iface");
217        system("$BRCTL stp $bridge off");
218        system("$IFCONFIG $bridge up");
219        system("$IFCONFIG $tap up");
220        system("$IFCONFIG $iface up");
221        return $?;
222    }
223}
224
225# Return the IP addresses accociated with this interface (as a list)
226sub iface_to_addr {
227    my($iface) = @_;
228    my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n";
229    my @addr;
230    my $uname = `uname`;
231    my $ipre = "inet\\s+([0-9\\.]+)";
232    chomp $uname;
233
234    if ($uname =~ /Linux/) {
235        $ipre = "inet\\s+addr:\\s*([0-9\\.]+)";
236    }
237
238    $ipipe->reader("$IFCONFIG $iface");
239    while(<$ipipe>) {
240        /$ipre/ && push(@addr, $1);
241    }
242    $ipipe->close();
243    return @addr;
244}
245
246# Return the interface that packets to this host (IP or DNS) would be sent on.
247sub dest_to_iface {
248    my($dest) =@_;
249    my $rpipe = new IO::Pipe() || die "Can't create pipe for route: $!\n";
250    my $uname = `uname`;
251    chomp $uname;
252    my $route;
253    my $dev_re;
254
255    if ($uname =~ /Linux/) {
256        $route = $IPROUTE;
257        $dev_re = "\\s+dev\\s+(\\S+)";
258    }
259    elsif ($uname =~ /FreeBSD/) {
260        $route = $ROUTE;
261        $dev_re = 'interface:\\s*([[:alnum:]]+)';
262    }
263
264
265    print "$route get $dest\n";
266    $rpipe->reader("$route get $dest");
267    while (<$rpipe>) {
268        /$dev_re/ && do {
269            my $iface = $1;
270            $rpipe->close();
271            print "matched: $iface\n";
272            return $iface;
273        };
274    }
275    $rpipe->close();
276
277    die "No route to $dest\n";
278}
279
280# Return the interface bound to this IP address.  If there are more than one,
281# the first one returned by ifconfig is the one returned.
282sub addr_to_iface {
283    my($addr) = @_;
284    my $ipipe = new IO::Pipe() || die "Can't create pipe for ifconfig: $!\n";
285    my $iface;
286
287    $ipipe->reader("$IFCONFIG");
288    while(<$ipipe>) {
289        /^([[:alnum:]]+):?/ && do {
290            $iface = $1;
291            next;
292        };
293        /inet(\s+addr:)?\s*([0-9\.]+)/ && do {
294            if ($2 eq $addr) {
295                $ipipe->close();
296                return $iface;
297            }
298        };
299    }
300    $ipipe->close();
301    die "Cannot match $addr to an interface\n";
302}
303
304sub read_config {
305    my($file, $map) = @_;
306    my %param;
307    my %keywords;
308    my $f;
309
310    foreach my $k (keys %{$map}) {
311        if ( $k =~ /(\S+)=[si]/ ) {
312            $keywords{$1} = $map->{$k};
313            $param{$1}++;
314        }
315        else {
316            $keywords{$k} = $map->{$k};
317        }
318    }
319
320    $f = new IO::File($file) || die "Can't open $file: $!\n";
321    while (<$f>) {
322        /^\s*([^:]+):\s*(.*)/ && do {
323            my $keyw = $1;
324            my $val = $2;
325
326            $keyw =~ tr [A-Z] [a-z];
327
328            if ($keywords{$keyw} ) {
329                if ( $param{$keyw} ) { 
330                    if ( ref($keywords{$keyw}) eq 'SCALAR') {
331                        ${$keywords{$keyw}} = $val;
332                    }
333                    elsif( ref($keywords{$keyw}) eq 'ARRAY') {
334                        push(@{$keywords{$keyw}}, $val);
335                    }
336                    else {
337                        die "Unknown variable type for $keyw\n";
338                    }
339                }
340                else  { ${$keywords{$keyw}}++; }
341            }
342            next;
343        };
344    }
345    $f->close();
346}
347
348
349sub config_filename {
350    # Find the configuration file in the usual places, if there is one in
351    # /usr/local/federation/etc, use it, otherwise look in the emulab standard
352    # filesystems which depends on what experiment and project we're in.
353    my $pid;
354    my $eid;
355    my $filename;
356    my $fed_dir = "/usr/local/federation/etc/";
357    my $hn = `hostname`;
358    chomp $hn;
359    $hn =~ s/\..*//;
360
361    return "$fed_dir/$hn.gw.conf" if -r "$fed_dir/$hn.gw.conf";
362
363    my $tmcd = new IO::Pipe() || die "Can't create pipe: $!\n";
364
365    $tmcd->reader("$TMCC status");
366
367    while (<$tmcd>) {
368        chomp;
369        /ALLOCATED=([^\/]+)\/(\S+)/ && do {
370            $pid = $1;
371            $eid = $2;
372        };
373    }
374    $tmcd->close();
375    $filename = "/proj/$pid/exp/$eid/tmp/$hn.gw.conf"
376        if $pid and $eid;
377
378    return $filename;
379}
380
381
382sub client_conf_filename {
383    # Find the configuration file in the usual places, if there is one in
384    # /usr/local/federation/etc, use it, otherwise look in the emulab standard
385    # filesystems which depends on what experiment and project we're in.
386    my $pid;
387    my $eid;
388    my $filename;
389    my $fed_dir = "/usr/local/federation/etc/";
390
391    return "$fed_dir/client.conf" if -r "$fed_dir/client.conf";
392
393    my $tmcd = new IO::Pipe() || die "Can't create pipe: $!\n";
394
395    $tmcd->reader("$TMCC status");
396
397    while (<$tmcd>) {
398        chomp;
399        /ALLOCATED=([^\/]+)\/(\S+)/ && do {
400            $pid = $1;
401            $eid = $2;
402        };
403    }
404    $tmcd->close();
405    $filename = "/proj/$pid/exp/$eid/tmp/client.conf"
406        if $pid and $eid;
407
408    return $filename;
409}
410
411sub wait_for_port {
412    my($addr, $port, $timeout, $sleep) = @_;
413    my $start = time();
414    $sleep = 5 unless $sleep;
415    die "Need both address and port\n" unless $addr && $port;
416
417    my $s;
418
419    while (!$s) {
420        # We've seen some arp pollution, so be proactive about clearing the
421        # cache if we're waiting to get out.
422        system("arp -d -a");
423        if (!($s = new IO::Socket(Domain => &AF_INET, PeerAddr => $addr, 
424            PeerPort => $port))) {
425            if ($timeout and time() - $start > $timeout) {
426                return undef;
427            }
428            else { sleep($sleep); }
429        }
430    }
431    $s->close();
432    return 1;
433
434}
435
436sub testcmd_repeat {
437    my($cmd, $timeout, $sleep) = @_;
438    my $start = time();
439    $sleep = 5 unless $sleep;
440
441    while (1) {
442        system("$cmd");
443        if ($?) {
444            if ($timeout and time() - $start > $timeout) {
445                return undef;
446            }
447            else { sleep($sleep); }
448        }
449        else { return 1; }
450    }
451}
452
453sub get_ip { 
454    my($name) = @_;
455    my $gwip;
456    if ( my $hent = gethostbyname($name) ) {
457        $gwip = inet_ntoa($hent->addr_list->[0]);
458    }
459    return $gwip;
460}
461
4621;
Note: See TracBrowser for help on using the repository browser.