interswitch.in 3.74 KB
Newer Older
Robert Ricci's avatar
Robert Ricci committed
1
#!/usr/bin/perl
Leigh Stoller's avatar
Leigh Stoller committed
2
#
3
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
23
#
24 25
use strict;
use English;
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
use Getopt::Long;

sub usage() {
    print "Usage: $0 [-h] [-a]\n";
    print " -h    Display this message\n";
    print " -a    Display all VLANs, not just those that cross trunks\n";
    return 1;
}

my %opt;
GetOptions(\%opt,'h','a');
if (@ARGV) {
    exit usage();
}

if ($opt{h}) {
    exit usage();
}

my $show_all = 0;
if ($opt{a}) {
    $show_all = 1;
}
49 50 51 52 53

#
# Turn off line buffering on output
#
$| = 1;
Leigh Stoller's avatar
Leigh Stoller committed
54

Robert Ricci's avatar
Robert Ricci committed
55
#
56 57 58
# Set umask for start/swap. We want other members in the project to be
# able to swap/end experiments, so the log and intermediate files need
# to be 664 since some are opened for append.
Robert Ricci's avatar
Robert Ricci committed
59
#
60 61 62 63 64 65 66 67 68 69
umask(0002);

#
# Untaint the path
#
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# Testbed Libraries.
Robert Ricci's avatar
Robert Ricci committed
70 71
use lib '@prefix@/lib';
use libdb;
72 73
use User;
use Lan;
74

75 76 77 78 79 80 81 82 83
#
# Verify user and get his DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist!\n");
}
if (!$this_user->IsAdmin()) {
84 85 86 87
    die("*** $0:\n".
	"    You must be a TB administrator to use this program\n");
}

88
my ($pid,$eid,$virtual,$id,$pideid,$members);
89 90 91 92 93 94 95 96 97 98 99 100
print << "END";
ID     Project/Experiment Link/LAN   Switches (number of members in parens)
--------------------------------------------------------------------------------
END
format vlanlist =
@<<<<< @<<<<<<<<<<<<<<<<< @<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$id,   $pideid,           $virtual,  $members
~~                                   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                                     $members
.
$FORMAT_NAME = 'vlanlist';

Robert Ricci's avatar
Robert Ricci committed
101 102 103 104

#
# Get a list of all VLANs for swapped-in experiments
#
105 106 107 108 109
my @vlans;
if (VLan->AllVLans(\@vlans) != 0) {
    die("*** $0:\n".
	"    Unable to load VLANs for all experiments\n");
}
Robert Ricci's avatar
Robert Ricci committed
110

111
foreach my $vlan (@vlans) {
Robert Ricci's avatar
Robert Ricci committed
112
    my %switches = ();
113 114 115 116 117 118 119 120 121 122 123
    my @members;
    my $pid = $vlan->pid();
    my $eid = $vlan->eid();

    $id = $vlan->lanid();
    $virtual = $vlan->vname();

    if ($vlan->MemberList(\@members) != 0) {
	die("*** $0:\n".
	    "    Unable to load members for $vlan\n");
    }
Robert Ricci's avatar
Robert Ricci committed
124
    foreach my $member (@members) {
125 126 127 128
	my $node;
	my $iface;

	if ($member->GetNodeIface(\$node, \$iface) != 0) {
129 130
	    print STDERR "Missing attributes for $member in $vlan\n";
	    next;
131 132
	}
	my $nodeid = $node->node_id();
Robert Ricci's avatar
Robert Ricci committed
133 134 135 136

	#
	# Find out which switch this interface is connected to
	#
137 138 139 140 141 142 143 144 145 146
	my $interface = Interface->LookupByIface($nodeid, $iface);
	if (!defined($interface)) {
	    print STDERR "No interface for $nodeid:$iface\n";
	    next;
        }
	if (!$interface->wiredup()) {
	    print STDERR "Interface for $nodeid:$iface is not wired up\n";
	    next;
        }
	$switches{$interface->switch_id()}++;
Robert Ricci's avatar
Robert Ricci committed
147 148 149 150 151
    }

    #
    # Report if more than one switch was found
    #
152
    if ($show_all || (scalar(keys(%switches)) > 1)) {
153 154 155
	$pideid = "$pid/$eid";
	$members = join(" ", map { "$_ ($switches{$_})" } sort keys %switches);
	write;
Robert Ricci's avatar
Robert Ricci committed
156 157
    }
}