@rem = '
@echo off
if exist %0.bat goto NOEXT
perl %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
goto END_BATCH_FILE
:NOEXT
perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
goto END_BATCH_FILE
@rem ';

#
# vpn.bat - Checks VPN 
# Created 1/12/01 by Cottrell.

$^W = 1;

# ------------------------------
#
# YOU MUST CONFIGURE THESE ITEMS for your site

my $vpn1 = "134.79.118.";
my $vpn2 = "134.79.119.";

my $remhost="ns1.slac.stanford.edu";
my $remip="134.79.16.9";
my $pchost="pcdata";

# NO CHANGES REQUIRED BELOW HERE
#
# ------------------------------

# All of these packages are installed by default with ActivePerl
# for Win32, available at http://www.activestate.com/. You may
# need to load your own packages for other versions.

use strict;
use Net::Ping;

my @ans; my $found; my $line; my $address="?"; my $temp; my $dnsaddr;
my $dest; my $mask; my $gate="?"; my $if; my $metric; my $rest;
my $debug=0;

(my $progname = $0) =~ s'^.*\\'';    # strip path components, if any'
use Sys::Hostname; my $host=hostname();
my $hostaddr=gethostbyname($host);
my ($a, $b, $c, $d)=unpack('C4',$hostaddr);
$hostaddr=$a.".".$b.".".$c.".".$d;

print scalar(localtime), " $progname starting on $host($hostaddr),\n",
  "  for " . Win32::DomainName() . "\\" . Win32::LoginName() . 
  ", to cancel use Ctrl/C\n";

# Create ping object
# see http://www.savstate.edu/adm/aa/documentation/perl/lib/Net/Ping.html
my $p = Net::Ping->new("icmp") 
  or die("new ping failed");

print "$progname is a tool for SLAC Windows DSL users",
      " to identify VPN problems.\n"; 

#  webget("171.66.185.249", "/monitor");
#  webget("www.slac.stanford.edu", "/index.html");

PING: {
  ###################################################################
  # Is user's machine running Windows NT service level 4 or greater?
  ###################################################################
  my ($string, $major, $minor, $build, $id)=Win32::GetOSVersion();
  my @os=("Win32s", "Win95 or 98", "WinNT or 2K or XP");
  print "You are running $os[$id], major version $major, $string,\n",
        "  minor version $minor, build $build", 
        " on $host($hostaddr).\n";
  if($id == 2) {#running NT/Win2K/XP, so check the service level
    my $level;
    ($temp, $temp, $level) = split /\s+/,$string;
    if($major==4) {
      if($level lt 4) {
        print "Your WNT service level is < 4 ($string),",
              " so VPN will not work on $host.\n",
              "  You need to upgrade to service pack 4 or later.\n";
        last PING;
      }
      else {
        print "  OK, you are running Windows NT $string, so I will try to help.\n";
      }
    }   
    elsif($major<4) {
      print "WNT version < 4 will not support VPN.\n";
      last PING; 
    }
    else {print "  OK, you are running Windows 2000 or XP, so I will try to help.\n";}
  }
  elsif($id == 1) {#running Win95/98, so check which one      
    my $build1 = (unpack "A4"x2, sprintf "%08X", (&Win32::GetOSVersion)[3])[1];
    if(hex $build1 eq "1998") {
      print "  OK, you are running Windows 98, so I will try to help.\n";
    }
    else {
      print "You are probably running Windows 95( hex $build1), so I cannot help.\n";
      last PING;
    }
  }
  else {
    print "I can't help you with $os[$id].\n";
    last PING;
  } 

  ##################################################################
  # Check loopback port is responding
  ##################################################################
  print "$progname checking if loopback is working on $host...\n";
  my $alive = $p->ping("loopback") || $p->ping("loopback");
  if($alive) {print "$progname OK found loopback responds to ping on $host\n";}
  else {
    print "$progname found loopback fails to respond to ping from $host";
    last PING;
  }

  ##################################################################
  # Try and find the gateway and see if it is pingable
  ##################################################################
  print "$progname checking for gateway using netstat -r ...\n";
  ($a,$b,$c,$d)=split/\./,$vpn1;
  my $site=$a.".".$b;
  @ans=`netstat -r`; 
  # Output from netstat -r appears as (for WinXP)
  #===========================================================================
  #Interface List
  #0x1 ........................... MS TCP Loopback interface
  #0x10003 ...00 02 2d 6a ea 97 ...... Dell TrueMobile 1150 Series Wireless LAN Mini PCI Card
  #0x10004 ...00 06 5b e7 56 07 ...... 3Com 3C920 Integrated Fast Ethernet Controller (3C905C-TX Compatible)
  #===========================================================================
  #===========================================================================
  #Active Routes:
  #Network Destination        Netmask          Gateway       Interface  Metric
  #        127.0.0.0        255.0.0.0        127.0.0.1       127.0.0.1       1
  #  255.255.255.255  255.255.255.255  255.255.255.255           10003       1
  #  255.255.255.255  255.255.255.255  255.255.255.255           10004       1
  #===========================================================================
  #Persistent Routes:
  #  None
  #
  #Route Table

  #So we need to trigger on the first occurence of the word Gateway, and finish when we
  #see the following line with ================ or Default in it
  if($debug>0) {print "@ans";}
  my $found=0; my $print=0;
  foreach $line (@ans) {
    if($line=~/Interface List/) {$print=1; print " Network ".$line; next}
    elsif ($line=~/^=========/) {$print=0;}
    if($print) {print "  ".$line;}
    if($line=~/Gateway /) {$found=1; next;}
    if($found) {
      $line=~s/^\s*//; #Remove leading spaces in line
      if($line =~/^=========/ || $line =~/^Default /) { $found=0;}
      else {
        ($dest, $mask, $gate, $if, $metric) = split /\s+/,$line;
        ($a,$b,$c,$d)=split/\./,$dest;
        if($metric == 1 && $a.".".$b eq $site) {$found=0;}
      }
    }
  }
  if($gate eq "127.0.0.1" || $gate eq "255.255.255.255") {     
    print "   However, the possible 'gateway' appears to be the loopback\n",
          "   or broadcast address $gate,\n",
          "   i.e. I can't find a valid gateway on any of the interfaces.\n",
          "   * You may need to shutdown and re-start your host ($host).\n",
          "   * Or try wiggling the Ethernet connector.\n",
          "   * Or maybe there is a mismatch between the NIC media type and the\n",
          "     switch/router port.\n",
          "   * Or you may need to dial up your Internet provider via your modem.\n",
          "   * Or maybe powering off your DSL router,\n",
          "     disconnecting the DSL line, reconnecting the DSL line, and\n",
          "     powering the DSL router back on again will help, \n",
          "     and note the status lights when it is fully back on \n",
          "     (the STATUS. POWER lights should be lit, and the light \n",
          "     on the LAN port the computer is plugged into should be lit or\n",
          "     or blinking. The DSL light may be off or blinking).\n",
          "     If the STATUS or POWER lights are not lit, then the DSL router\n",
          "     probably is malfunctioning. If the LAN light is not lit or not\n",
          "     blinking, then maybe you have a wiring problem or your computer\n",
          "     is malfunctioning.  To eliminate it being a wiring problem\n",
          "     try plugging the computer directly into the DSL router.\n", 
          "     You could try pinging your DSL router from somewhere else\n",
          "     on the Internet. If it does not respond, maybe your DSL\n",
          "     circuit is bad.\n";
    $found=0;
    @ans=`ipconfig`;
    foreach $line (@ans) {
      if($line =~ /Media disconnected/) {
        $found=1;
      }
    }
    if($found) {
      print "Network Interface Card (NIC) media disconnected.\n",
            "Output from ipconfig:\n@ans";
    }
    last PING;
  }    
  elsif($gate eq "169.154.122.18") {
    print "   However, the possible 'gateway' address appears to be the default\n",
          "   Microsoft gateway address $gate.\n",
          "   Maybe DHCP has not given you an address, try the DOS commands:\n",
          "     ipconfig /release\n", 
          "     ipconfig /renew\n";
    last PING;
  }  
  else { 
    print "$progname OK found possible gateway $gate interface $if metric $metric\n";
    print "$progname check gateway $gate is reachable from $host...\n";
    $alive = $p->ping($gate) || $p->ping($gate);
    if ( $alive) {
      print "$progname OK gateway $gate responds to ping from $host\n";
    }
    elsif ( !$alive ) {
      print "$progname gateway $gate does not respond to ping from $host.\n",
            "   You may need to shutdown and re-start your host ($host).\n",
            "   Or try wiggling the Ethernet connector.\n",
            "   Or you may need to dial up your Internet provider via your modem.\n",
            "   Or maybe powering off your DSL router,\n",
            "   disconnecting the DSL line, reconnecting the DSL line, and\n",
            "   powering the DSL router back on again will help.\n",
            "   You could try pinging your DSL router from somewhere else\n",
            "   on the Internet. If it does not respond, maybe your DSL\n",
            "   circuit is bad.\n";
      last PING;
    }
  }

  #################################################################
  # See if we can ping an Internet address.
  #################################################################
  print "$progname check if can ping Internet address $remip ...\n";
  $alive= $p->ping($remip) || $p->ping($remip);
  if(!$alive) { 
    print "Can't ping $remip,\n",
          "  your gateway connection works, but I cannot ping $remip.\n";
    ###############################################################
    #Maybe pings are blocked, see if we have a DNS host & try pinging that
    ###############################################################
    @ans=`ipconfig /all`;
    if($debug > 0) {
      print "  I will look in ipconfig to see if there is a DNS server and try & ping it.\n@ans";
    }
    foreach $line (@ans) {
      if($line=~/DNS Servers/) {
        ($temp,$rest)=split /:/,$line;
        if($rest=~/\s*(\d+\.)(\d+\.)(\d+\.)(\d+)/) {
          $dnsaddr=$1.$2.$3.$4;
          if($dnsaddr ne "") {
            print "  You have a DNS server address=$dnsaddr, I will try and ping it.\n";
            $alive = $p->ping($dnsaddr) || $p->ping($dnsaddr); 
            if(!$alive) {
              print "Can't ping DNS server at $dnsaddr,\n",
                    "  I give up!\n";
              last PING;
            }
            else {
              print "DNS server at $dnsaddr is pingable, MAYBE pings are blocked offsite.\n",
                    "  Try connecting from your web browser to a web server somewhere, e.g. www.google.com (64.233.167.104)\n",
                    "  or if that fails try power cycling your DSL gateway box\n";
              last PING;
            }
          }
          else {
            print "You do not have a designated DNS server, your IP configuation is:\n",
                  "@ans";
            last PING;
          }            
        }
        else {
          print "You do not have a designated DNS server, your IP configuation is:\n",
                "@ans";
          last PING;
        } 
      }
    }         
    last PING;
  }
  print "$progname OK can ping $remip\n";
 
  #################################################################
  # See if we can get an address for the remote host.
  #################################################################
  print "$progname check Domain Name Server can resolve IP address for $remhost...\n";
  my $remaddr=gethostbyname($remhost);
  if(!$remaddr) {
    @ans=`nslookup $remhost`;
    print "Can't resolve $remip,\n", 
          "  looks like you cannot access a working Domain Name Server.\n",
          "Output from nslookup $remhost:\n",
          "@ans";
    last PING;
  }
  ($a, $b, $c, $d)=unpack('C4',$remaddr);
  $remaddr=$a.".".$b.".".$c.".".$d;
  print "$progname OK DNS resolved $remaddr as address for $remhost\n";

  ################################################################
  # Does user's machine have RAS installed?
  ################################################################
  if($major==4 && $id==2) {#Running WNT so check for RAS
    use Win32::Registry;
    my $ptr="REMOTEACCESS"; my $ras;
    if(!$main::HKEY_CURRENT_USER->Open($ptr, $ras)) {
      print "$progname can't find RAS client on $host,\n",
            "  contact your administrator to install RAS.\n";
      last PING;
    }
  }
  print "$progname OK RAS is installed on $host,",
        " I will continue checking...\n";

  ###############################################################
  # See if we can reach a well known host, 
  # if so traceroute to it, and look in
  # the route for the NTVPN server.
  ###############################################################
  print "$progname checking if can reach $remhost ($remaddr) from $host...\n";
  $alive = $p->ping($remhost) || $p->ping($remhost);
  $found=0;
  my $vpna=$vpn1."1"; my $vpnb=$vpn2."1";
  if ($alive) {
    print "$progname OK can ping $remhost at $remaddr from $host,\n", 
          "  you have an Internet connection\n";
    if($debug>0) {print "Doing tracert $remhost, looking for $vpna or $vpnb\n";}
    @ans=`tracert -d -h 5 $remhost`; 
    if($debug>0) {print "@ans";}
    foreach $line (@ans) {
      if($line=~/$vpna/ || $line=~/$vpnb/) {
        if($line=~/$vpna/) {$address=$vpna;} else {$address=$vpnb;}
        $found=1; last; 
      } 
    } 
  }
  else {
    print STDERR "$progname can't ping $remhost\n";
    last PING;
  }
  if ($found) {print STDERR "$progname OK found potential",
                     " VPN address $address in tracert.\n",
                     "  It appears you have a VPN connection.\n";
  }
  else {
    print STDERR "$progname can't find VPN server in tracert,\n", 
                 "  probably means you have not successfully dialed into VPN.\n";
    if(!(Win32::DomainName() eq 'SLAC')) {
      print "$progname notes that your userid (".Win32::LoginName().") is in",
            "   domain ".Win32::DomainName()."."."\n", 
            "   To dial into the SLAC VPN your userid must be in the SLAC domain.\n",
            "   If you have a SLAC domain userid then you may need to specify the\n",
            "   domain and userid in the User name when connecting to VPN,\n",
            "   e.g. SLAC\\".Win32::LoginName()."\n";
    }
    last PING;
  }
  print "$progname checking whether Netbios is running over the TCP/IP connection.\n";
  my $i; my $vpn; my $vpn0; 
  $vpn=$address; $found=0;
  if($vpn=~/$vpn1/ || $vpn=~/$vpn2/) {
    if(!($found=vpnup($vpn,$p,"A"))) {
      VPN:
      for ($i=1; $i<20; $i++) {
        foreach $vpn0 ($vpn1,$vpn2) {
          $vpn=$vpn0.$i;
          if($found=vpnup($vpn,$p,"A")) {
            print "@ans\n";
            last VPN;
          }
        }
      }
    }
  }
  if($found) {
    print "$progname OK found a Windows Netbios connection over TCP/IP to $vpn\n";
  }
  else {
    print "$progname unable to find a Windows connection to $vpn.\n",
          "  You will probably have to wait for the VPN server to be restarted.\n";
    last VPN;
  }
  print "$progname checking whether Windows Name Services (WINS) are running...\n";
  if($found=vpnup($pchost,$p,"a")) {
    print "$progname OK found Windows Name Services (WINS) are running to $pchost.\n";
  }
  else {
    print "$progname can't find Windows Name Services (WINS) running to $pchost.\n";
    last VPN;
  } 
  vpnok("ntvpn1.slac.stanford.edu");
  vpnok("ntvpn2.slac.stanford.edu");  
}

##############################################################
# Clean up & exit.
##############################################################
print scalar(localtime), " $progname DONE on $host\n";
# need some way to signal exit
$p->close();
Win32::Sleep(60*60*1000); #keep the window being displayed
exit(0);

sub webget {
  use IO::Socket;
  unless ($#_ > 0) { die "usage: $0 host document ...";}
  my $host=shift(@_); 
  my $remote; my $document;
  foreach $document (@_) {
    $remote=IO::Socket::INET->new( Proto => "tcp",
      PeerAddr => $host,
      PeerPort => "http(80)",
    );
    unless($remote) {die "cannot connect to http daemon on $host";}
    $remote->autoflush(1);
    print $remote "GET $document HTTP/1.0\n\n";
    while (<$remote>) {print;}
    close $remote;
  }
}  

sub vpnup {
  my ($vpn, $p)=@_;
  my $line;
    print "  checking with nbtstat -$_[2] $vpn for Netbios connection over TCP to $vpn...\n";
    my $found=0;
    my $alive = $p->ping($vpn) || $p->ping($vpn); #Check if pingable
    if($alive) {
      print "  OK found $vpn is responding to ping.\n";
      my @ans=`nbtstat -$_[2] $vpn`; 
      foreach $line (@ans) {
        if($line=~/MAC Address/) {$found=1; if($debug>0) {print "@ans\n";}}
      }
    }
  return $found;
}


sub vpnok {
# vpnok("134.79.116.30");
  use Socket;
  my($pptpserver, $pptpport, $iaddr, $sin, $tcpproto);
  $pptpserver = shift || 'ntvpn1.slac.stanford.edu';
  $pptpport = 1723; # pptp control port
  $iaddr = inet_aton($pptpserver) or die "Unable to resolve PPTP server name $pptpserver";
  $tcpproto = getprotobyname('tcp') or die "Unable to determine protocol number for TCP";
  ################################################
  # Attempt to connect to PPTP server control port
  ################################################
  print("$progname attempting TCP connect to PPTP server $pptpserver control port $pptpport ...\n");
  socket(SOCK, PF_INET, SOCK_STREAM, $tcpproto) or die "Unable to create socket: $!";
  $sin = sockaddr_in($pptpport, $iaddr);
  connect(SOCK, $sin) or die "Unable to connect: $!";
  close(SOCK) or die "Unable to close: $!";
  print("$progname OK connection to $pptpserver:$pptpport successful \n");
}

__END__
:END_BATCH_FILE