#!/usr/bin/perl -w # my $C = 'Copyright 2008-2013 Paul D. Smith '; # # MadScientist JNC Session Manager # I know this script is really long, but it turns out doing anything # with a GUI takes a lot of--mostly grunt-work--code. Fun! # # This is a followup to my previous version, which was written in POSIX sh. # That version simply invoked the Juniper-provided Network Connect GUI; # this was problematic because that GUI needed 32bit Java and didn't work # well with non-Sun/Oracle versions of Java. # # This version has its own GUI using Perl/GTK2, so it doesn't need # any Java at all. Yay! # my $L = ' This script is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This script 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 General Public License for more details.'; # # Requires that Perl GTK2 be installed. # Typically this means using your package manager to install packages such as # Red Hat/Fedora: perl-Gtk2 perl-libwww-perl # Debian/Ubuntu: libgtk2-perl libwww-perl # # This script tries to detect the REALM. If there's only one realm possible # then typically it will be embedded in the web page; in that case we can # find it. If there is >1 realm then you'll have to look at the page source # and try to find them. Look for something like: # # and use "XXXX" (no quotes) as the realm value. my $VERSION = '2.5'; my $RELDATE = '17 Feb 2013'; my $RELURL = 'http://mad-scientist.net/juniper.html'; our $debug = $ENV{__MSJNC_DEBUG__} || 0; use strict; use Carp; use Getopt::Long; use File::Copy; use File::Temp qw(tempdir); use POSIX qw(_exit setsid strftime); use Net::Ping; use LWP::Simple; # Get graphics use Glib; use Gtk2; use Gtk2::SimpleMenu; use Gtk2::Pango; # For debug use Data::Dumper; $ENV{PATH} = '/sbin:/usr/sbin:/bin:/usr/bin:'.$ENV{PATH}; umask(022); # General-purpose variables our $HOME; my %OPTS; my $JNPATH; my $JNCPATH; my $NCSVC; my $JNCICON; my $GETCERT = 'getx509certificate.sh'; my $INTEST = 0; # Log objects my $LOGFILE = '.msjnc.log'; my $LOGH = undef; # GUI objects my $WIN; my $TRAY; my %OBJ; my $CONN; my $DESKTOP = '[Desktop Entry] Name=Network Connect Comment=MadScientist Juniper Network Connect Session Manager Type=Application Terminal=false StartupNotify=false Categories=Network; Actions=Disconnect Icon=@@ICON@@ Exec=@@CMD@@ [Desktop Action Disconnect] Name=VPN Session Disconnect Exec=@@CMD@@ --disconnect'; # --------------- UTILITIES # Generic small utility functions # Print version info sub version { print "MadScientist JNC Session Manager Version $VERSION -- $RELDATE $RELURL\n"; if ($NCSVC && -x $NCSVC) { local $_ = `$NCSVC -v 2>&1`; $? == 0 or $_ = "Failed to run $NCSVC.\n".$_; print "\n$_"; } exit(0); } # Given a timestamp (in time() format) return the elapsed time # in the form HH:MM:SS sub elapsed { my $i = time() - $_[0]; local $_ = ''; if ($i > 86400) { $_ = int($i/86400).'d '; $i %= 86400; } return sprintf("%s%02d:%02d:%02d", $_, $i/3600, ($i % 3600)/60, $i % 60); } # Convert a count of bytes into something more readable sub cvtbytes { my $b = shift; # If we have < 1K use B $b < 1024 and return "$b B"; # If we have < 1M use K $b < (1024 * 1024) and return sprintf("%.2f KiB", ($b / 1024.0)); # If we have < 1G use M $b < (1024 * 1024 * 1024) and return sprintf("%.2f MiB", $b / (1024.0 * 1024.0)); # Use G return sprintf("%.2f GiB", $b / (1024.0 * 1024.0 * 1024.0)); } # Read the contents of a file and return it as a string. # Remove the trailing newline if there is one. # Return undef if the file could not be read. sub readfile { local $_; open(my $F, '<', $_[0]) or return undef; { local $/ = undef; $_ = <$F>; } close($F) or return undef; chomp; return $_; } sub logln { if (! $LOGH) { open($LOGH, '>>', "$HOME/$LOGFILE") or die "$HOME/$LOGFILE: $!\n"; my $s = select $LOGH; $| = 1; select $s; } local $_ = join('', @_); s/\n*$//; print $LOGH strftime("%F %T%z: ", localtime()), "$_\n"; return 1; } our $log = \&logln; # Return a true value if a file has changed since the last time it was called # or undef if doesn't exist or hasn't changed. # You need to pass in the previously returned changed value. sub filechanged { my ($fn, $info) = @_; my @s = stat($fn) or return undef; # If the info is empty, initialize it $info && %$info or $info = {ino => 0, size => 0, mtime => 0}; # If nothing's changed since the last check, return undef $info->{ino} == $s[1] && $info->{size} == $s[7] && $info->{mtime} == $s[9] and return undef; # Something changed return {ino => $s[1], size => $s[7], mtime => $s[9]}; } # This function invokes a child process and writes a password to its stdin # If the first option is a ref, it's hash of options ($OPT). # If $OPT->{wait} is not set runs in the background and returns the PID. # Otherwise, returns 1 if the child succeeds, 0 otherwise. sub pwd_child { my $o = ref $_[0] ? shift : {}; my $pwd = shift; $log->("Writing passwd to child: @_\n"); # We want to write to the child so set up a pipe my ($rd, $wr); pipe($rd, $wr) or die "pipe: $!\n"; # Run it! my $pid = fork(); defined $pid or die "fork: $!\n"; if (! $pid) { # Child open(my $N, '>', '/dev/null'); open(STDOUT, '>&', $N); # Unfortunately sudo -S is broken: if the incoming password is # bad it still tries to read more. Stupid! Throw out stderr. open(STDERR, '>&', $N); # If we're not waiting, change the process group $o->{wait} or setsid(); # Read stdin from the pipe open(STDIN, '<&', $rd); if (!exec(@_)) { print STDOUT "Failed to run $_[0]: $!\n"; _exit(0); } } # Parent # Send the password then close close($rd); print $wr "$pwd\n"; close($wr); if (! $o->{wait}) { $log->("Running pid $pid in the background"); return $pid; } # Wait for the child to finish. $log->("Waiting for pid $pid"); waitpid($pid, 0) == $pid or die "waitpid($pid): $!\n"; my $r = $?; $log->("result: $r (", ($r >> 8), ")"); return $r == 0; } # --------------- CONNECTION PROFILES # Manage connection profiles package jnc::Profile; use Carp; my $PROFILEFILE = '.msjnc-profiles.cfg'; my $PROF_LOG = undef; my $PROFILES = {default => 0, list => {}}; my $IDMAX = 0; my %IDMAP = (); sub _saveprofiles { my $sfile = "$main::HOME/$PROFILEFILE"; # Create a dumper object my $dumper = Data::Dumper->new([ $PROFILES ], [ 'valstore' ]) ->Indent(0)->Purity(1)->Deepcopy(1); my $u = umask(0077); open(my $S, '>', "$sfile.$$") or die "open: $sfile.$$: $!\n"; print $S $dumper->Dump(), "\n" or die "write: $sfile.$$: $!\n"; close($S) or die "close: $sfile.$$: $!\n"; umask($u); rename("$sfile.$$", $sfile) or die "rename($sfile.$$, $sfile): $!\n"; return 1; } sub _loadprofiles { my $sfile = "$main::HOME/$PROFILEFILE"; my $new = main::filechanged($sfile, $PROF_LOG) or return 1; $PROF_LOG = $new; my $dumped = main::readfile($sfile); defined $dumped or return 1; chomp $dumped; # Eval the contents to set the profile variable. my $valstore; my $r = eval($dumped); $@ and die "Failed to parse $sfile: $@\n"; $PROFILES = $valstore; $IDMAX = 0; %IDMAP = (); while (my ($n, $v) = each %{$PROFILES->{list}}) { $IDMAP{$v->{pfid}} = $n; $v->{pfid} > $IDMAX and $IDMAX = $v->{pfid}; } return 1; } sub list { _loadprofiles(); my @names = sort keys %{$PROFILES->{list}}; return wantarray ? @names : scalar(@names); } # Create a new profile. Return a copy. sub new { my ($class, $pf) = @_; $pf or confess "jnc::Profile::get: undefined profile\n"; my $name = $pf->{name} or confess "jnc::Profile::get: undefined profile name\n"; _loadprofiles(); exists $PROFILES->{list}->{$name} and confess "jnc::Profile::new: Profile $name already exists\n"; $pf->{pfid} = ++$IDMAX; $PROFILES->{list}->{$name} = { %$pf }; _saveprofiles(); $IDMAP{$pf->{pfid}} = $name; return $pf; } # Return a copy of the profile data or undef if it doesn't exist sub get { my ($class, $name) = @_; $name or return undef; _loadprofiles(); exists $PROFILES->{list}->{$name} or return undef; return { %{$PROFILES->{list}->{$name}} }; } # Return a copy of the profile data or undef if it doesn't exist # Look up based on ID, not name sub get_byid { my ($class, $id) = @_; $id or return undef; _loadprofiles(); exists $IDMAP{$id} or return undef; return jnc::Profile->get($IDMAP{$id}); } # Set the profile data # Returns a copy of the new profile data (a la get()) sub set { my ($class, $new) = @_; $new or confess "jnc::Profile::set: undefined new\n"; my $nm = $new->{name} or confess "jnc::Profile::set: undefined name\n"; exists $PROFILES->{list}->{$nm} or confess "jnc::Profile::set: unknown name\n"; $PROFILES->{list}->{$nm}->{pfid} == $new->{pfid} or confess "jnc::Profile::set: id doesn't match\n"; $PROFILES->{list}->{$nm} = $new; _saveprofiles(); return { %$new }; } # Rename a profile. Return a copy of the new profile, or undef if it fails. # Do the right thing when renaming the default or active profile. sub rename { my ($class, $oldname, $new) = @_; $oldname or confess "jnc::Profile::rename: undefined oldname\n"; $new or confess "jnc::Profile::rename: undefined new\n"; _loadprofiles(); exists $PROFILES->{list}->{$oldname} or confess "jnc::Profile::rename: unknown profile $oldname\n"; # Can't overwite an existing profile exists $PROFILES->{list}->{$new->{name}} and return undef; $PROFILES->{list}->{$oldname}->{pfid} == $new->{pfid} or confess "jnc::Profile::rename: id doesn't match\n"; # Rename it delete $PROFILES->{list}->{$oldname}; $PROFILES->{list}->{$new->{name}} = $new; _saveprofiles(); return { %$new }; } # Remove a profile. # Do the right thing when deleting the default or active profile sub remove { my ($class, $name) = @_; $name or confess "jnc::Profile::remove: undefined name\n"; _loadprofiles(); my $id = $PROFILES->{list}->{$name}->{pfid}; delete $PROFILES->{list}->{$name}; # If this is the default, unset the default $PROFILES->{default} eq $id and $PROFILES->{default} = 0; _saveprofiles(); return 1; } # Set the default profile. Use '' to unset the default. # Returns the profile name on success, or undef on error sub set_default { my ($class, $name) = @_; if (! $name) { $PROFILES->{default} = 0; } else { _loadprofiles(); exists $PROFILES->{list}->{$name} or return undef; $PROFILES->{default} = $PROFILES->{list}->{$name}->{pfid}; } _saveprofiles(); return $name; } # Return the name of the default profile or undef if none sub get_default { _loadprofiles(); return $IDMAP{$PROFILES->{default}} || undef; } sub debug { my ($class, $pf) = @_; foreach my $k (sort keys %$pf) { print "$k = $pf->{$k}\n"; } return 1; } # --------------- VPN CONTROL # Manage the current VPN session package jnc::Session; use strict; use Carp; use Time::Local; my %CURRENT = (); my $ACTIVE = 0; my $LOG = undef; my $LOG_OFFSET = 0; my $LOG_LAST = ''; # We have to make a distinction between an ncsvc we started ($CHILD) # and one we may have just found already running. $PID is the ncsvc pid. # We guarantee that if $CHILD is set, $PID is always equal to it. # Conversely, if $PID is not set, $CHILD is always 0. my $PID = 0; my $CHILD = 0; # Convert a date as given in the NC log to time() format sub _cvtdate { $_[0] =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ or die "INTERNAL: invalid date: $_[0]\n"; return timelocal($6, $5, $4, $3, $2-1, $1-1900); } # Get the active profile, or undef if there isn't one. sub _get_current_pf { $CURRENT{pfid} or return undef; my $pf = jnc::Profile->get_byid($CURRENT{pfid}); if (! $pf) { $log->("Session: Profile $CURRENT{pfid} does not exist."); $CURRENT{pfid} = 0; } return $pf; } # Return a copy of the current status of the session sub get { return { %CURRENT }; } sub get_status { return $CURRENT{status}; } sub set_active { my ($class, $id) = @_; my $pf = jnc::Profile->get_byid($id); $pf and $ACTIVE = $id; return $ACTIVE; } sub get_active_pf { return $ACTIVE ? jnc::Profile->get_byid($ACTIVE) : undef; } # Given a profile name, if there is a script associated with it # then run it. Returns false if not invoked or success, or true on failure sub run_script { my $pf = _get_current_pf() or return 0; my $script = $pf->{script} or return 0; $log->("Session: run user script: $script @_"); if (! -f $script || ! -x $script) { $log->("Session: $script: $!"); return 1; } # Set up the environment $ENV{jnc_profile} = $pf->{name}; foreach (qw(url host port svcport realm user proxy proxy_port proxy_domain proxy_user)) { $ENV{"jnc_$_"} = $pf->{$_} || ''; } local $_ = `$script @_ 2>&1`; my $r = $?; $log->("> $_"); $r == 0 and return 0; $log->("Session: $script failed: $r (", ($r >> 8), ')'); return 1; } # This is invoked when the connection has completed. sub _connected { my ($noop, $server, $ctime) = @_; $log->("DBG: Connected: $server ($ctime)") if $main::debug; $CURRENT{status} = 'Connected'; $CURRENT{server} = $server; $CURRENT{ctime} = $ctime; $CURRENT{timedout} = 0; $CURRENT{retrying} = 0; # If we have a "maybe" password, we now know it's good $CURRENT{pwd_maybe} and $CURRENT{pwd_good} = $CURRENT{pwd_maybe}; $CURRENT{proxy_maybe} and $CURRENT{proxy_good} = $CURRENT{proxy_maybe}; $CURRENT{pwd_maybe} = $CURRENT{proxy_maybe} = undef; if (! $noop) { $log->("Session: connected successfully"); run_script('connected'); } return 1; } # Invoke this when a disconnect is discovered sub _disconnected { my $noop = $_[0]; $log->("DBG: Disconnected noop=$noop") if $main::debug; $CURRENT{status} = 'Disconnected'; $CURRENT{address} = ''; $CURRENT{iface} = undef; $CURRENT{pwd_maybe} = $CURRENT{proxy_maybe} = undef; if (! $noop) { $log->("Session: disconnected"); run_script('disconnected'); } return 1; } # Completely clean out the session status sub clean { _disconnected(1); $CURRENT{pfid} = 0; $CURRENT{pwd_good} = $CURRENT{proxy_good} = undef; $CURRENT{pwd_maybe} = $CURRENT{proxy_maybe} = undef; $CURRENT{ctime} = 0; $CURRENT{received} = $CURRENT{sent} = 0; $CURRENT{total_ctime} = 0; $CURRENT{total_received} = $CURRENT{total_sent} = 0; return 1; } # Read the log file and process any change in state. # Returns 0 if the log didn't exist, 1 otherwise. sub _readlog { my $noop = $_[0]; # See if we think the log has been changed since the last time # If it has, then read it in to detect state changes. # This is kind of a hack but it's the only mostly-accurate way I know of. my $new = main::filechanged("$JNCPATH/ncsvc.log", $LOG) or return 1; # If the inode is different or the file got smaller it's a new log ! $LOG || $new->{ino} != $LOG->{ino} || $new->{size} < $LOG->{size} and $LOG_OFFSET = 0; # Remember the current state, for next time $LOG = $new; # Look through the log file, starting where we left off last time open(my $L, '<', "$JNCPATH/ncsvc.log"); if (! $L) { $log->("Session: $JNCPATH/ncsvc.log: $!"); return 0; } my %prev = %CURRENT; # Jump to where we last left off. If this fails never mind, we'll # just read from the beginning. seek($L, $LOG_OFFSET, 0); local $_; # If we have a partial line left over from the last read start with that $LOG_OFFSET && $LOG_LAST and $_ = $LOG_LAST; $LOG_LAST = ''; my $l = 0; # Read in from where we left off while (1) { my $n = <$L>; defined $n or last; $_ .= $n; ++$l; # If there is no newline here then save it and stop: partial line if (! /\n$/) { $LOG_LAST = $_; last; } if (/^(\d+)\..*\sncsvc\.info\s+Connecting\s+to\b.*?\s([-.a-zA-Z0-9]+)(:[0-9]+)?\s+\(/) { $log->("DBG: $1: Connecting") if $main::debug; $CURRENT{status} = 'Connecting'; $CURRENT{server} = $2; } elsif (/^(\d+)\..*\ssession\.info\s+Connected\s+to\b.*?\s([-.a-zA-Z0-9]+)\s+\(/) { $log->("DBG: $1: Connected") if $main::debug; _connected($noop, $2, _cvtdate($1)); } elsif (/(\d+)\..*\ssession\.info\s+disconnecting\s+from\s/) { $log->("DBG: $1: Disconnecting") if $main::debug; $CURRENT{status} = 'Disconnecting'; } elsif (/(\d+)\..*\ssession\.info\s+disconnected\s+from\s/) { $log->("DBG: $1: Disconnected") if $main::debug; _disconnected($noop); } elsif (/(\d+)\..*\sncapp\.error\s+Failed\s+to\s+authenticate\s/) { $log->("DBG: $1: Auth failed") if $main::debug; clean($noop); $CURRENT{status} = 'Failed'; } elsif (/^(\d+)\..*\sncphandler\.info\s+session\s+timedout\s+\(/) { $log->("DBG: $1: Timeout") if $main::debug; $CURRENT{timedout} = _cvtdate($1); } elsif (/(\d+)\..*\ssession\.info\s+IVE\s+sent\s+NC\s+IP\s+([.0-9]+)/) { # Or: /(\d+)\..*\badapter\.info\s+cip\s*=\s*([.0-9]+)\S*\s+mask/ $CURRENT{address} = $2; } $_ = ''; } if ($main::debug) { $log->("DBG: parsed $l log lines\n") if $main::debug > 1; $LOG_LAST and $log->("DBG: Partial line: '$LOG_LAST'"); } $prev{status} eq $CURRENT{status} or $log->("Session: Change from $prev{status} to $CURRENT{status}"); # Save the amount of file we've already parsed $LOG_OFFSET = tell($L); close($L); return 1; } sub _retry { my $pf = _get_current_pf(); if ($pf && $pf->{retry} && $CURRENT{pwd_good} && ! $CURRENT{retrying}) { $CURRENT{total_ctime} or $CURRENT{total_ctime} = $CURRENT{ctime}; $CURRENT{total_received} += $CURRENT{received}; $CURRENT{total_sent} += $CURRENT{sent}; $log->("DBG: Retrying") if $main::debug; jnc::Session->connect() and $CURRENT{retrying} = 1; } else { # We can't retry; we're really disconnected. # Clear out the "total" fields. $CURRENT{total_ctime} = 0; $CURRENT{total_received} = $CURRENT{total_sent} = 0; } return 1; } sub _getpid { my $arg = $_[0] ? "-p '$_[0]'" : '-e'; # This appears to be the most portable option. # Kind of gross that we may have to run ps(1) on every update, but... local $_ = `ps $arg -o pid= -o comm=`; return m,^\s*(\d+)\s(?:.*/)?ncsvc$, ? $1 : 0; } sub update { # If true, run in no-op mode (don't run scripts, retry, etc.) my ($class, $noop) = @_; # Act on any changes to the current status my $rlog = _readlog($noop); # If we're connected and don't have a PID, we better be able to find one if ($CURRENT{status} eq 'Connected' && ! $PID) { $PID = _getpid(); $PID and $log->("Session: Found previously-running PID $PID\n"); } if ($CHILD) { # If we have a child, see if it died and reap it if so if (waitpid($CHILD, 1) == $CHILD) { my $r = $?; $log->("Session: PID $CHILD exited with ", ($r << 8), " ($r)"); $PID = $CHILD = 0; } } elsif ($PID && ! _getpid($PID)) { # We have a non-child PID but it's not valid anymore $PID = 0; } # If we don't have a PID but appear to be connected, disconnect if (! $PID && $CURRENT{status} ne 'Disconnected') { $log->("Session: Log says Connected, but no PID: disconnecting.\n"); _disconnected($noop); } # If _readlog() failed (no log file?) skip early if (! $rlog) { clean(); return get(); } # If we have an address and we don't know the interface yet, find it if ($CURRENT{address} && ! $CURRENT{iface}) { foreach (split /^\d+:\s*/m, `ip addr show`) { if (m,^(\S+):\s.*\sinet\s\Q$CURRENT{address}\E/,s) { $CURRENT{iface} = $1; last; } } } # If we have an interface get the sent/received bytes values from sysfs if ($CURRENT{iface}) { my $d = "/sys/class/net/$CURRENT{iface}/statistics"; $_ = main::readfile("$d/rx_bytes"); if (! defined $_) { $log->("Session: $d/rx_bytes: $!"); } else { $CURRENT{received} = $_; } $_ = main::readfile("$d/tx_bytes"); if (! defined $_) { $log->("Session: $d/tx_bytes: $!"); } else { $CURRENT{sent} = $_; } } if ($CURRENT{status} eq 'Disconnected') { if ($CURRENT{timedout}) { # Retry if we're disconnected and we timed out $log->("Session: Timeout detected at $CURRENT{timedout}"); _retry(); $CURRENT{timedout} = 0; } else { # Didn't time out, so reset the counters $CURRENT{total_ctime} = 0; $CURRENT{total_received} = $CURRENT{total_sent} = 0; } } return get(); } # Query the provided host for a certificate and return the pathname. # Return false if we can't get one. sub get_cert { my ($class, $host) = @_; $log->("Session: Retrieving certificate from $host"); my $cn = "$JNPATH/.cert.$host"; unlink($cn); my $u = umask(0077); system("cd '$JNPATH' && /bin/bash ./'$GETCERT' '$host' '$cn' >/dev/null 2>&1"); my $r = $?; umask($u); if ($r != 0 || ! -f $cn || -z _) { $log->("Session: Retrieval failed: $r (", ($r >> 8), ')'); unlink($cn); return undef; } return $cn; } # This method is used to connect: creates a session of a profile sub connect { my ($class, $pwd, $proxy_pwd) = @_; # We're starting a new connect; any "maybe" passwords are obsolete $CURRENT{pwd_maybe} = $CURRENT{proxy_maybe} = undef; # If the active profile is not the same as the current one, set it if ($ACTIVE != $CURRENT{pfid}) { $CURRENT{pfid} = $ACTIVE; $CURRENT{pwd_good} = $CURRENT{proxy_good} = undef; $CURRENT{total_ctime} = 0; $CURRENT{total_received} = $CURRENT{total_sent} = 0; $CURRENT{timedout} = $CURRENT{retrying} = 0; } # If there's no active profile we can't connect. my $pf = _get_current_pf(); if (! $pf) { $ACTIVE = 0; return 0; } $log->("Session: connecting using profile $pf->{name}: $pf->{host} user $pf->{user}"); # Remember possible password info, if SecurID is not set # If we don't have new passwords, try the old ones if ($pwd) { $pf->{securid} or $CURRENT{pwd_maybe} = $pwd; } else { $pwd = $CURRENT{pwd_good}; } if ($proxy_pwd) { $pf->{securid} or $CURRENT{proxy_maybe} = $proxy_pwd; } else { $proxy_pwd = $CURRENT{proxy_good}; } # If we don't have a password, give up if (! $pwd) { $log->("Session: no password available"); return 0; } my @cmd = ($NCSVC, '-h', $pf->{host}, '-u', $pf->{user}, '-r', $pf->{realm}); $pf->{svcport} and push @cmd, ('-P', $pf->{svcport}); $pf->{url} and push @cmd, ('-U', $pf->{url}); # If we have a proxy add those arguments if ($pf->{proxy}) { if (! $proxy_pwd) { $log->("Session: no proxy password available"); return 0; } push @cmd, ('-y', $pf->{proxy}, '-z', $pf->{proxy_port}, '-d', $pf->{proxy_domain}, '-s', $pf->{proxy_user}, '-a', $proxy_pwd); } my $cert = jnc::Session->get_cert($pf->{host}) or die "Cannot obtain VPN certificate from $pf->{host}\n"; push @cmd, ('-f', $cert); $PID = $CHILD = main::pwd_child($pwd, @cmd); return $CHILD; } sub disconnect { $log->("Session: disconnecting"); system($NCSVC, '-K'); return $? == 0; } package main; # --------------- WINDOW # Manage the main status window sub tray_icon_event { if ($WIN->get_property('visible')) { $WIN->hide(); } else { $WIN->show(); } } sub window_debug_signal { my ($widget, $info) = @_; print "window_debug_signal: $info\n"; return 0; } sub window_debug_event { my ($widget, $event, $info) = @_; print "window_debug_event: $info\n"; return 0; } sub window_state { my ($w, $e, $d) = @_; print "Got event $e (", Dumper($e), ")\n"; if ($e->new_window_state('iconified')) { print "iconified!\n"; } elsif (! $e->new_window_state('iconified')) { print "not iconified!\n"; } return 0; } # Show a yes/no question. Returns 1 for yes, 0 for no. sub window_yn { my $w = shift; my $d = Gtk2::MessageDialog->new($w, 'destroy-with-parent', 'question', 'yes-no', @_); $d->show_all(); my $r = $d->run(); $d->destroy(); return $r eq 'yes'; } # Show an error. Returns 1. sub window_error { my $w = shift; my $d = Gtk2::MessageDialog->new($w, 'destroy-with-parent', 'error', 'ok', @_); $d->show_all(); my $r = $d->run(); $d->destroy(); return 1; } # Show a warning. Returns 1 on ok or 0 on cancel. sub window_warn { my $w = shift; my $d = Gtk2::MessageDialog->new($w, 'destroy-with-parent', 'warning', 'ok-cancel', @_); $d->show_all(); my $r = $d->run(); $d->destroy(); return $r eq 'ok'; } # Read a password and return it sub window_passwd { my ($title, $msg) = @_; # create a dialog window my $dialog = Gtk2::Dialog->new($title, $WIN, 'destroy-with-parent', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok'); $dialog->set_default_response('ok'); $dialog->get_content_area()->pack_start(Gtk2::Label->new($msg), 1, 0, 2); # This is the entry box for the password my $entry = Gtk2::Entry->new(); $entry->set_visibility(0); $entry->set_invisible_char('*'); $entry->set_width_chars(25); $entry->signal_connect(activate => sub { $dialog->response('ok') }); $dialog->get_content_area()->pack_start($entry, 1, 0, 2); # Run it $dialog->show_all(); my $r = $dialog->run(); my $pwd = $r eq 'ok' ? $entry->get_text() : undef; $dialog->destroy(); return $pwd; } sub window_delete { # If you return 0 in the "delete_event" signal handler, # GTK will emit the "destroy" signal. Returning 1 means # you don't want the window to be destroyed. # This is useful for popping up 'are you sure you want to quit?' # type dialogs. if (jnc::Session->get_status() =~ /^Connect/) { window_yn($WIN, "Exiting the application will not disconnect the VPN session. Do you want to continue to exit?") or return 1; } return 0; } # Return the name of the active profile # If there isn't one ask the user to choose sub window_choose_active { # Do we have an active session? my $pf = jnc::Session->get_active_pf(); if (! $pf) { # Nothing yet my @l = jnc::Profile->list(); if ($#l > 0) { # We have >1, so let the user choose my $pfn = window_choose("Choose active profile:", 'gtk-connect'); $pf = jnc::Profile->get($pfn) or return undef; } elsif ($#l == 0) { # Exactly one profile exists, just use it $pf = jnc::Profile->get($l[0]); } else { # No profiles exist; allow the user to create one and use that $pf = window_edit() or return undef; } } # Return the session chosen by the user jnc::Session->set_active($pf->{pfid}); return $pf->{name}; } sub window_update { # Note our current state so we can see if it's changed my $oldstatus = jnc::Session->get_status(); my $vpn = jnc::Session->update(0); my $server = $vpn->{server} || '---'; # If there's an active session, print info on it my $pf = jnc::Session->get_active_pf(); if ($pf) { $OBJ{frame}->set_label("Profile: $pf->{name}"); $vpn->{server} and $server .= " ($pf->{realm})"; } else { $OBJ{frame}->set_label('VPN Status'); } # If the status changed, update that my $status = $vpn->{status}; my $markup = "$status"; if ($markup ne $OBJ{status}->get_label()) { $OBJ{status}->set_markup("$status"); if ($status =~ /^Connect/) { $CONN->set_label('Disconnect'); $CONN->set_image($OBJ{disconnect}); $OBJ{disconnect}->show(); $CONN->set_sensitive(1); } else { $CONN->set_label('Connect'); $CONN->set_image($OBJ{connect}); $OBJ{connect}->show(); $CONN->set_sensitive(1); } } $WIN->set_title($pf ? "MS-JNC: $pf->{name}" : 'MS JNC'); $OBJ{server}->set_text($server); if ($status ne 'Connected') { foreach my $k (qw(elapsed sent received address)) { $OBJ{$k}->set_text('---'); } } else { $OBJ{address}->set_text($vpn->{address} || '---'); local $_ = elapsed($vpn->{ctime} || 0); $vpn->{total_ctime} and $_ .= ' ('.elapsed($vpn->{total_ctime}).')'; $OBJ{elapsed}->set_text($_); foreach my $k (qw(sent received)) { $_ = cvtbytes($vpn->{$k} || 0); $vpn->{"total_$k"} and $_ .= ' ('.cvtbytes($vpn->{$k}+$vpn->{"total_$k"}).')'; $OBJ{$k}->set_text($_); } } return 1; } # Connect or disconnect sub window_dis_connect { my $label = $CONN->get_label(); if ($label ne 'Connect') { # Disconnects are simple jnc::Session->disconnect(); goto UPDATE; } # Make sure we have a current profile my $pfn = window_choose_active(); if (! $pfn) { window_error($WIN, "You must have an active profile before you can connect."); goto UPDATE; } my $pf = jnc::Profile->get($pfn); if (! $pf) { # This shouldn't ever happen...?!?! window_error($WIN, "Active profile $pfn is not valid!"); goto UPDATE; } if (! -f '/etc/resolv.conf') { window_error($WIN, "The /etc/resolv.conf file must exist."); goto UPDATE; } # Get passwords. It works like this: if there's a previous "known good" # password, then just use it without asking. If the user saved a # password that counts as a "known good" password. If there's no # "known good" password then ask for one. my ($proxy_pwd, $pwd); my $sess = jnc::Session->get(); if ($pf->{proxy}) { $proxy_pwd = $pf->{proxy_passwd} || $sess->{proxy_good} || window_passwd("Enter proxy password", "Enter the proxy server password:") or goto UPDATE; } $pwd = $pf->{passwd} || $sess->{pwd_good} || window_passwd("Enter password", "Enter your password or PIN+SecurID:") or goto UPDATE; # If we have what we need, start the session! jnc::Session->connect($pwd, $proxy_pwd); UPDATE: window_update(); return 1; } sub window_about { # Create the about content my $dialog = Gtk2::Dialog->new('About MS-JNC', $WIN, 'destroy-with-parent', 'gtk-ok' => 'ok'); my $content = $dialog->get_content_area(); # Show the script version information my $hb = Gtk2::HBox->new(0, 10); $hb->pack_start(Gtk2::Image->new_from_file($JNCICON), 0, 0, 2); $hb->pack_start(Gtk2::Label->new(" MadScientist JNC Session Manager Version $VERSION ($RELDATE) $RELURL "), 0, 0, 2); $content->pack_start_defaults($hb); # Show the JNC version information if (-x $NCSVC) { $content->pack_start_defaults(Gtk2::HSeparator->new()); local $_ = `$NCSVC -v 2>&1`; $? == 0 or $_ = "Failed to obtain Network Connect version\n".$_; chomp; my $l = Gtk2::Label->new($_); $l->modify_font(Gtk2::Pango::FontDescription->from_string("Monospace 8")); my $a = Gtk2::Alignment->new(0.1, 0.5, 0.0, 0.0); $a->add($l); $content->pack_start_defaults($a); } # Create a dialog and add the about content $dialog->set_default_response('ok'); $dialog->show_all(); $dialog->run(); $dialog->destroy(); return 1; } # Make a window busy (if $_[1] is true) or not busy (if $_[1] is false) sub window_busy { my ($win, $isbusy) = @_; # I can't seem to get this to work :-/ I must be doing something wrong. # It was working at first but not anymore. Weird. return 1; if ($isbusy) { print "busy\n"; $win->window()->set_cursor(Gtk2::Gdk::Cursor->new('watch')); $win->set_sensitive(0); } else { print "not busy\n"; # The docs say I can use undef here but it gives an error on RHEL6: # GLib-GObject-CRITICAL **: g_object_notify: assertion `G_IS_OBJECT (object)' failed #$win->window()->set_cursor(undef); $win->window()->set_cursor(Gtk2::Gdk::Cursor->new('pointer')); $win->set_sensitive(1); } return 1; } # Check the URL field as soon as practical. We don't, though, want # to check it if the user hasn't actually changed anything. my $OLD_URL = ''; my $OLD_PROXY = ''; sub window_url_event { my ($w, $event, $d) = @_; my ($edit, $pf) = @$d; my $old_url = $OLD_URL; $OLD_URL = $edit->{url}->get_text(); my $old_proxy = $OLD_PROXY; $OLD_PROXY = $edit->{proxy}->get_text(); # Empty or nothing changed so keep going. (! $OLD_URL && ! $OLD_PROXY) || ($old_url eq $OLD_URL && $old_proxy eq $OLD_PROXY) and return 0; # If the check succeeds, keep going. Else don't move forward. # Signal return values seem backwards to me but... return window_url_check($edit, $pf) == 0; } # Check the URL field value for validity. # Returns 1 if it's OK and we should move forward or 0 if not valid. # Note this is the opposite of signal returns (odd...) sub window_url_check { my ($edit, $pf) = @_; $pf->{host} = $pf->{port} = undef; local $_ = $edit->{url}->get_text(); my $hostnm; my $url; my $fqdnre = '[a-zA-Z0-9][-.a-zA-Z0-9]*'; if (/^(($fqdnre)(?::(\d+))?)$/) { $hostnm = $1; $pf->{host} = $2; $pf->{port} = $3 || getservbyname('https', 'tcp') || 443; } elsif (m,^((https?)://(($fqdnre)(?::(\d+))?).*)$,) { $url = $1; $hostnm = $3; $pf->{host} = $4; $pf->{port} = $5 || getservbyname($2,'tcp') || ($2 eq 'http'? 80 : 443); } else { window_error($edit->{dialog}, "Server/URL: Please provide a full URL, hostname, or hostname:port."); $edit->{url}->grab_focus(); return 0; } # See if there's a proxy set up. $_ = $edit->{proxy}->get_text(); if ($_) { if (/^(($fqdnre)(?:(\d+))?)$/) { $hostnm = $1; $pf->{proxy_host} = $2; $3 and $pf->{proxy_port} = $3; } else { window_error($edit->{dialog}, "Proxy Server: Please provide a hostname or hostname:port."); $edit->{proxy}->grab_focus(); return 0; } } # Seems to be the proper format. Now see if it's a valid hostname. # If it's not, ask the user if they really want to use it. If so, # we return 1 (keep going). If not, we re-select the entry box. # Set the window to busy while we check things out window_busy($edit->{dialog}, 1); # Make sure we can resolve the hostname if (! gethostbyname($pf->{host})) { window_busy($edit->{dialog}, 0); window_yn($edit->{dialog}, "Unknown host $hostnm Use it anyway?") and return 1; $edit->{url}->grab_focus(); return 0; } # Make sure we can connect to the hostname my $ping = Net::Ping->new('tcp', 2); $ping->port_number($pf->{port}); if (! $ping->ping($pf->{host})) { window_busy($edit->{dialog}, 0); window_yn($edit->{dialog}, "$hostnm is not responding. Use it anyway?") and return 1; $edit->{url}->grab_focus(); return 0; } # If we didn't get a URL from the user, construct it now. $url or $url = ($pf->{port} == 80 ? 'http' : 'https') ."://$pf->{host}" .($pf->{port} == 80 || $pf->{port} == 443 ? '' : ":$pf->{port}"); # If we don't already have a realm value see if we can figure it out if (! $edit->{realm}->get_text()) { local $_ = get($url); $_ && /]*\sname="realm"[^>]*\svalue="(.+?)"/s and $edit->{realm}->set_text($1); } if (! jnc::Session->get_cert($pf->{host})) { window_busy($edit->{dialog}, 0); window_yn($edit->{dialog}, "Failed to obtain certificate from $hostnm Use it anyway?") and return 1; $edit->{url}->grab_focus(); return 0; } window_busy($edit->{dialog}, 0); return 1; } # This shows the profile information dialog box # The first argument should be the name of the profile to edit, or # false to create a new profile. # Returns a ref to the profile data sub window_edit { my $sname = $_[0] || ''; my $pf = $sname ? jnc::Profile->get($sname) : {}; # Keep all the interesting objects here my %edit = (); # Remember the previous value of the URL & proxy $OLD_URL = $pf->{url} || ''; $OLD_PROXY = $pf->{proxy} || ''; # create a dialog window $edit{dialog} = Gtk2::Dialog->new('MS JNC VPN Profile', $WIN, 'destroy-with-parent', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok'); $edit{dialog}->set_default_response('ok'); # These are the fields that will be on the dialog, and their titles my %fields = (name => 'Name this profile', user => 'Username', passwd => 'Password', url => 'Server/URL', realm => 'Realm', proxy => 'Proxy Server', proxy_domain => 'Proxy Domain', proxy_user => 'Proxy User', proxy_passwd => 'Proxy Password'); # These are the default widths for the various fields # If not here the default (20) will be used my %widths = (url => 30, realm => 10, name => 30, proxy => 30); # I wanted to check the hostname dynamically when the user is done. # This is non-obvious in Gtk2 from what I can see. The activate signal # is only emitted if the user presses ENTER, but not if they TAB away or # click on another entry. However if I hook to the focus-out-event I # get the event invoked every time the focus moves away, including to # click cancel or to another window etc. Since the command can take a # while if the hostname lookup fails or the host is not reachable, this # really sucks. # Instead what I decided to do is add a trigger to the focus-in-event # of all the OTHER fields. When we enter a field we'll check to see # if the URL is set and has been changed since the last time we checked. # If so we'll check it. If not we do nothing. # Then we need to check it again when "OK" is pressed since we might # have jumped straight from the host field to "OK" without focusing # any of the other fields. # Create the entries foreach my $f (keys %fields) { $edit{$f} = Gtk2::Entry->new(); $edit{$f}->set_width_chars($widths{$f} || 20); $edit{$f}->set_text($pf->{$f} || ''); $edit{$f}->signal_connect('focus-in-event' => \&window_url_event, [\%edit, $pf]); } # Create a checkbox for the auto-retry mode $edit{retry} = Gtk2::CheckButton->new('Auto-reconnect'); $edit{retry}->set_active($pf->{retry}); $edit{retry}->signal_connect('focus-in-event' => \&window_url_event, [\%edit, $pf]); # Create a checkbox for the SecurID mode $edit{securid} = Gtk2::CheckButton->new('SecurID'); $edit{securid}->set_active($pf->{securid}); $edit{securid}->signal_connect('focus-in-event' => \&window_url_event, [\%edit, $pf]); # Create a file chooser for the script $edit{script} = Gtk2::FileChooserButton->new('Session Script', 'open'); if ($pf->{script}) { $edit{script}->set_filename($pf->{script}); } else { $edit{script}->set_current_folder($HOME); } $edit{script}->signal_connect('focus-in-event' => \&window_url_event, [\%edit, $pf]); # Extra configuration $edit{passwd}->set_visibility(0); $edit{passwd}->set_invisible_char('*'); $edit{proxy_passwd}->set_visibility(0); $edit{proxy_passwd}->set_invisible_char('*'); # Pack it into the dialog box my $content = $edit{dialog}->get_content_area(); my ($table, $a, $frame, $top); # Create a section for the profile name my $hb = Gtk2::HBox->new(0, 10); $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add(Gtk2::Label->new("$fields{name}:")); $hb->pack_start($a, 0, 0, 2); $hb->pack_end($edit{retry}, 0, 0, 2); $content->pack_start($hb, 0, 0, 2); $content->pack_start($edit{name}, 0, 0, 2); # Create a section for the username/password info $frame = Gtk2::Frame->new('VPN Account'); $frame->set_label_align(0.05, 0.8); $table = Gtk2::Table->new(2, 2, 0); $table->set_row_spacings(2); $table->set_col_spacings(2); $table->set_border_width(2); $a = Gtk2::Alignment->new(1.0, 0.5, 0.0, 0.0); $a->add(Gtk2::Label->new("$fields{user}:")); $table->attach_defaults($a, 0, 1, 0, 1); $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add($edit{user}); $table->attach_defaults($a, 1, 2, 0, 1); $a = Gtk2::Alignment->new(1.0, 0.5, 0.0, 0.0); $a->add(Gtk2::Label->new("$fields{passwd}:")); $table->attach_defaults($a, 0, 1, 1, 2); $hb = Gtk2::HBox->new(0, 10); $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add($edit{passwd}); $hb->pack_start($a, 0, 0, 2); $hb->pack_end($edit{securid}, 0, 0, 2); $table->attach_defaults($hb, 1, 2, 1, 2); # $top = 0; # foreach my $f (qw(user passwd)) { # $a = Gtk2::Alignment->new(1.0, 0.5, 0.0, 0.0); # $a->add(Gtk2::Label->new("$fields{$f}:")); # $table->attach_defaults($a, 0, 1, $top, $top+1); # $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); # $a->add($edit{$f}); # $table->attach_defaults($a, 1, 2, $top, $top+1); # ++$top; # } $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add($table); $frame->add($a); $content->pack_start($frame, 0, 0, 2); # Create a section for the servername/realm info $frame = Gtk2::Frame->new('VPN Server'); $frame->set_label_align(0.05, 0.8); $table = Gtk2::Table->new(2, 2, 0); $table->set_row_spacings(2); $table->set_col_spacings(2); $table->set_border_width(2); $top = 0; foreach my $f (qw(url realm)) { $a = Gtk2::Alignment->new(1.0, 0.5, 0.0, 0.0); $a->add(Gtk2::Label->new("$fields{$f}:")); $table->attach_defaults($a, 0, 1, $top, $top+1); $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add($edit{$f}); $table->attach_defaults($a, 1, 2, $top, $top+1); ++$top; } $frame->add($table); $content->pack_start($frame, 0, 0, 2); # Create a section for the proxy info $frame = Gtk2::Frame->new('VPN Proxy'); $frame->set_label_align(0.05, 0.8); $table = Gtk2::Table->new(4, 2, 0); $table->set_row_spacings(2); $table->set_col_spacings(2); $table->set_border_width(2); $top = 0; foreach my $f (qw(proxy proxy_domain proxy_user proxy_passwd)) { $a = Gtk2::Alignment->new(1.0, 0.5, 0.0, 0.0); $a->add(Gtk2::Label->new("$fields{$f}:")); $table->attach_defaults($a, 0, 1, $top, $top+1); $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add($edit{$f}); $table->attach_defaults($a, 1, 2, $top, $top+1); ++$top; } $frame->add($table); $content->pack_start($frame, 0, 0, 2); # Create a section for the session script $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add(Gtk2::Label->new("Session Script:")); $content->pack_start($a, 0, 0, 2); $content->pack_start($edit{script}, 0, 0, 2); # Show it all and wait for the user to "OK" $edit{dialog}->show_all(); my $orig = { %$pf }; # Let the user make changes. while (1) { my $r = $edit{dialog}->run(); # If the user didn't click OK then give up without saving if ($r ne 'ok') { $edit{dialog}->destroy(); return undef; } # Verify that what they entered is valid window_url_check(\%edit, $pf) or next; # Retrieve all the new entries into the profile foreach my $f (keys %fields) { $pf->{$f} = $edit{$f}->get_text(); } $pf->{retry} = $edit{retry}->get_active(); $pf->{securid} = $edit{securid}->get_active(); $pf->{script} = $edit{script}->get_filename(); if (! $pf->{name}) { window_error($edit{dialog}, "Please choose a name for this profile."); $edit{name}->grab_focus(); next; } # See if the name has changed if ($sname && $sname ne $pf->{name}) { # We can't rename to an existing if (vpn::Profile->get($pf->{name})) { window_error($edit{dialog}, "Profile $pf->{name} exists. Please choose a different name."); $edit{name}->grab_focus(); next; } } if (! $pf->{url}) { window_error($edit{dialog}, "Please provide a server hostname or URL."); $edit{url}->grab_focus(); next; } if (! $pf->{realm}) { window_error($edit{dialog}, "Please provide a VPN realm name."); $edit{realm}->grab_focus(); next; } if (! $pf->{user}) { window_error($edit{dialog}, "Please provide a username."); $edit{user}->grab_focus(); next; } if ($pf->{script} && ! -x $pf->{script}) { window_error($edit{dialog}, "The script $pf->{script} must be executable"); $edit{script}->grab_focus(); next; } if ($pf->{passwd} || $pf->{proxy_passwd}) { if (! window_warn($edit{dialog}, "Passwords are stored in plain text! For security leave them blank; you'll be asked to enter the password on connection.")) { my $f = $pf->{passwd} ? 'passwd' : 'proxy_passwd'; $edit{$f}->grab_focus(); next; } } # Seems OK last; } $edit{dialog}->destroy(); $sname or return jnc::Profile->new($pf); return $sname eq $pf->{name} ? jnc::Profile->set($pf) : jnc::Profile->rename($sname, $pf); } # Create a combobox containing the various profiles to choose from sub window_mk_chooser { my $cbox = Gtk2::ComboBox->new_text(); my $pfn = jnc::Profile->get_default(); my $idx = 0; foreach (sort jnc::Profile->list()) { $cbox->append_text($_); $pfn && $pfn eq $_ and $cbox->set_active($idx); ++$idx; } $pfn or $cbox->set_active(0); return $cbox; } # Pop up a dialog to choose a profile. Returns the profile name. sub window_choose { my ($title, $stock) = @_; # Make a dialog to contain the chooser my $dialog = Gtk2::Dialog->new('Choose Profile', $WIN, 'destroy-with-parent', 'gtk-cancel' => 'cancel', $stock => 'ok'); $dialog->set_default_response('ok'); my $cbox = window_mk_chooser(); my $c = $dialog->get_content_area(); $c->pack_start(Gtk2::Label->new($title), 0, 0, 2); $c->pack_start($cbox, 0, 0, 2); $dialog->show_all(); my $r = $dialog->run(); my $pfn = $r eq 'ok' ? $cbox->get_active_text() : undef; $dialog->destroy(); return $pfn; } # Manage profiles sub window_manage { my $cmd = shift; # New... just do it. $cmd eq 'new' and return window_edit(undef); # Get a profile to manage my $pfn = window_choose( $cmd eq 'delete' ? ('Choose profile to delete:', 'gtk-delete') : $cmd eq 'edit' ? ('Choose profile to edit:', 'gtk-edit') : $cmd eq 'current' ? ('Choose profile to use:', 'gtk-apply') : ('Choose the default profile:', 'gtk-apply')) or return 0; $cmd eq 'default' and return jnc::Profile->set_default($pfn); $cmd eq 'delete' and return jnc::Profile->remove($pfn); if ($cmd eq 'current') { my $pf = jnc::Profile->get($pfn); return jnc::Session->set_active($pf->{pfid}); } # Edit return window_edit($pfn); } sub window_create { my $window = Gtk2::Window->new('toplevel'); $window->set_border_width(10); $window->set_title('MS JNC'); $window->set_default_icon_from_file($JNCICON); # Handle WM delete events $window->signal_connect(delete_event => \&window_delete); $window->signal_connect(destroy => sub { Gtk2->main_quit(); }); # Create a vbox to hold the window content my $vb = Gtk2::VBox->new(0, 2); # Create the File menu my $caction = 0; my $menudata = [ _File => { item_type => '', children => [ _MinimizeToTray => { callback => \&tray_icon_event, }, _Quit => { callback => sub { window_delete() or Gtk2->main_quit(); }, callback_action => ++$caction, accelerator => 'Q' } ], }, _Profiles => { item_type => '', children => [ _Current => { callback => \&window_manage, callback_data => 'current', callback_action => ++$caction }, Separator => { item_type => '' }, _New => { callback => \&window_manage, callback_data => 'new', callback_action => ++$caction }, Default => { callback => \&window_manage, callback_data => 'default', callback_action => ++$caction }, _Edit => { callback => \&window_manage, callback_data => 'edit', callback_action => ++$caction }, _Delete => { callback => \&window_manage, callback_data => 'delete', callback_action => ++$caction } ], }, _Help => { item_type => '', children => [ _About => { callback => \&window_about, callback_action => ++$caction } ] } ]; my $menu = Gtk2::SimpleMenu->new(menu_tree => $menudata) or die "Failed to create menu\n"; $vb->pack_start($menu->{widget}, 0, 0, 0); $window->add_accel_group($menu->{accel_group}); %OBJ = (); # Create "connected" and "disconnected" stock images $OBJ{connect} = Gtk2::Image->new_from_stock('gtk-connect', 'button'); $OBJ{disconnect} = Gtk2::Image->new_from_stock('gtk-disconnect', 'button'); # Create a table inside a frame to hold the status my $sframe = Gtk2::Frame->new('VPN Status'); $sframe->set_label_align(0.05, 0.8); $OBJ{frame} = $sframe; my $status = Gtk2::Table->new(6, 2, 0); $status->set_row_spacings(2); $status->set_col_spacings(20); $status->set_border_width(2); # Add in the first column my $top = 0; foreach my $l (qw(Status: Server: Address: Duration: Sent: Received:)) { my $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $a->add(Gtk2::Label->new($l)); $status->attach_defaults($a, 0, 1, $top, $top+1); ++$top; } # Add in the second column $top = 0; foreach my $k (qw(status server address elapsed sent received)) { my $a = Gtk2::Alignment->new(0.0, 0.5, 0.0, 0.0); $OBJ{$k} = Gtk2::Label->new(""); $a->add($OBJ{$k}); $status->attach_defaults($a, 1, 2, $top, $top+1); ++$top; } # Add the status to the frame $sframe->add($status); # Add the frame to the vbox $vb->pack_start_defaults($sframe); # Create a button to connect/disconnect $CONN = Gtk2::Button->new(); $CONN->set_label('Connect'); $CONN->set_image($OBJ{connect}); $OBJ{connect}->show(); $CONN->signal_connect(clicked => \&window_dis_connect); $vb->pack_start_defaults($CONN); # Add the table to the window $window->add($vb); # Create system tray icon my $tray = Gtk2::StatusIcon->new_from_file($JNCICON); $tray->set_tooltip("MS-JNC"); $tray->signal_connect('activate', \&tray_icon_event); $TRAY = $tray; $window->show_all(); $WIN = $window; return $window; } # --------------- SETUP # If Network Connect is already available then obtain the "active" info # If Network Connect is not set up yet, do that # Run a command via sudo, passing the password via stdin. sub sudo { my $pwd = shift; return pwd_child({wait => 1}, $pwd, qw(sudo -S /bin/sh -c), "@_"); } # This runs the given command with superuser privileges. # It may require a password dialog so WIN must exist. my $PWD_sudo = undef; my $PWD_su = undef; sub asroot { # If we are root we can just run it if ($< == 0) { $log->("Running: @_\n") if $debug; system(@_); return $? == 0; } # If not root and we have no sudo password try to get one while (! $PWD_sudo) { $PWD_sudo = window_passwd("Enter Password", " Installation requires admin privileges. Enter your GNU/Linux account password: "); sudo($PWD_sudo, 'id -u') and last; $PWD_sudo = undef; # If they want to give up go to the next method window_yn($WIN, "Bad password or this account doesn't have admin privileges. Retry the password entry?") or last; } # If we have a password, run the command $PWD_sudo and return sudo($PWD_sudo, @_); # If no sudo, use su(1). Su is so lame that we can't give it a password # unless we have a terminal. I could have used Expect but forget it; # just run it in an xterm like Juniper does. $log->("Running: xterm -e 'su -c '@_''\n") if $debug; system(qw(xterm -e), "echo Enter the root password; su -c '@_'"); # Feh. xterm doesn't propogate the exit code of the shell command. # This is useless. return $? == 0; } # Set up the initial pathnames. Note they may not exist! sub setpaths { # Find the user's home directory $HOME = $ENV{HOME}; if (! $HOME || ! -d $HOME) { $HOME = (getpwuid($>))[7]; $HOME && -d $HOME or die "No home directory found!\n"; } $JNPATH = "$HOME/.juniper_networks"; $JNCPATH = "$JNPATH/network_connect"; if ($ENV{__MSJNC_TEST__}) { $NCSVC = $ENV{__MSJNC_TEST__}; $INTEST = 1; } else { $NCSVC = "$JNCPATH/ncsvc"; $INTEST = 0; } $JNCICON = "$JNPATH/networkconnect.gif"; } sub setup { my $opts = shift; local $_; # Don't run as root !$opts->{root} && $< == 0 and die "This utility should not be run as root. Please run it directly.\n"; # Find the JNC content if (! -d $JNPATH) { system(qw(mkdir -p), $JNPATH); $? == 0 or die "Failed to create $JNPATH\n"; } # Did the user give one? my $jar = "$JNPATH/ncLinuxApp.jar"; my $jopt = $opts->{jarfile}; if ($jopt && $jopt ne $jar) { # Do we have one already? -f $jar and die "$jar exists: cannot use --jarfile $jopt\n"; -f $jopt && -r _ or die "$jopt: $!\n"; copy($jopt, $jar) or die "Failed to copy $jopt to $jar\n"; } else { # Can we find one? -f "$jar" && -r _ or die "$jar: $!\nJuniper Network Connect is not installed!\n"; } # Do we have a directory for it? Make it if (! -d $JNCPATH) { system(qw(mkdir -p), $JNCPATH); $? == 0 or die "Failed to create directory $JNCPATH\n"; } # Is it unpacked? If not, do that now if (! -f $NCSVC) { system("cd '$JNCPATH' && unzip -q '$jar'"); $? == 0 or die "Failed to unpack $jar\n"; -f $NCSVC or die "Malformed Network Connect file $jar (no ncsvc)\n"; chmod 0755, $NCSVC, "$JNCPATH/ncdiag", "$JNCPATH/installNC.sh", "$JNCPATH/xlaunchNC.sh"; } # If the getcert script is not available obtain it # It seems to sometimes disappear from the network_connect directory if (! -f "$JNPATH/$GETCERT") { my $tmp = "$JNCPATH/$GETCERT"; if (! -f $tmp) { my $td = tempdir(CLEANUP => 1); system("cd '$td' && unzip -q '$jar' $GETCERT"); $? == 0 && -f "$td/$GETCERT" or die "Malformed Network Connect file $jar (no $GETCERT)\n"; $tmp = "$td/$GETCERT"; } # Somehow this file sometimes disappears; keep it copy($tmp, "$JNPATH/$GETCERT") or die "copy $GETCERT failed: $!\n"; } # Make sure we have an icon file. If not unpack it if (! -f $JNCICON) { -f "$JNCPATH/NC.jar" or die "$JNCPATH/NC.jar: $! Invalid installation of Juniper Network Connect!\n"; my $gif = `unzip -p -q '$JNCPATH/NC.jar' networkconnect.gif`; $? == 0 && $gif or die "Failed to extract icon from $JNCPATH/NC.jar\n"; open(my $I, '>', $JNCICON) or die "open: $JNCICON: $! Failed to create Juniper Network Connect icon file.\n"; print $I $gif; close($I) or die "close: $JNCICON: $! Failed to create Juniper Network Connect icon file.\n"; chmod 0644, $JNCICON; } # Make sure we have a FreeDesktop applicaton file, or create it my $deskdir = "$HOME/.local/share/applications"; if (! -d $deskdir) { system(qw(mkdir -p), $deskdir); $? == 0 or die "Failed to create $deskdir\n"; } my $deskfile = "$deskdir/ms-jnc.desktop"; if (! -f $deskfile) { $_ = $DESKTOP; s/\@\@ICON\@\@/$JNCICON/gs; s/\@\@CMD\@\@/$0/gs; open(my $D, '>', $deskfile) or die "open: $deskfile: $! Failed to create application definition.\n"; print $D $_; close($D) or die "close: $deskfile: $! Failed to create application definition.\n"; } return 1; } # Returns the set of commands needed to be run to fix the application # permissions, or empty if it's all good. sub check_app { # In test mode we don't have to do any of this $INTEST and return (); # Collect all the operations we need to run as root into a shell command my @cmd = (); # Make sure the ncsvc app has the right privileges my @s = stat($NCSVC) or die "$NCSVC: $!\n"; $s[4] == 0 && $s[5] == 0 or push @cmd, "chown 0:0 '$NCSVC'"; ($s[2] & 07777) == 06711 or push @cmd, "chmod 06711 '$NCSVC'"; # First make sure there's a TUN device: it has been reported that # Knoppix, for example, doesn't provide one by default if (! -c '/dev/net/tun') { window_yn($WIN, "There is no TUN device available. Should I create one?") or exit(0); push @cmd, 'mknod /dev/net/tun c 10 200 && chmod 0666 /dev/nut/tun'; } # Do we need to do something as root? return @cmd ? 'r=0'.join('', map {"; $_ || r=1"} @cmd).'; exit $r' : ''; } # This function verifies that the tools are setuid and if not, sets them It # will need to get a password so it should not be invoked until after the # window is created. sub setup_app { my $cmd = check_app() or return 1; # We need to fix something, do it as root. $log->("JNC configuration required: $cmd"); asroot($cmd); # Unfortunately we cannot rely on the exit codes of all the commands # (xterm, I'm looking at you!) So instead after we run it, see if # there's anything left to do and fail if so. check_app() and die "Failed to configure the Network Connect application\n"; return 1; } sub get_one_passwd_tty { my $prompt = shift; # Get the new password $SIG{'INT'} = 'IGNORE'; system(qw(stty -echo)); $? == 0 or die "Cannot disable character printing.\n"; print "$prompt: "; my $pwd = ; print "\n"; system(qw(stty echo)); $SIG{'INT'} = 'DEFAULT'; $? == 0 or die "Cannot enable character printing.\n"; $pwd =~ /^(.*)$/; $1 or die "No password provided. Stop.\n"; return $1; } sub get_passwd_tty { my $pf = shift; my $pwd = $pf->{passwd} || get_one_passwd_tty("Enter your password or PID+SecureID"); my $proxy_pwd = $pf->{proxy} ? $pf->{proxy_passwd} || get_one_passwd_tty("Enter the proxy password") : ''; return ($pwd, $proxy_pwd); } # --------------- MAIN # Get the various pathnames we'll expect. Note they may not exist yet! setpaths(); # Parse the command line GetOptions(\%OPTS, 'help|h|?' => sub { Getopt::Long::HelpMessage(); }, 'version|V' => \&version, 'jarfile=s', 'profile=s', 'root', 'fg', 'connect', 'disconnect', 'uninstall') or exit(1); # Initialize the VPN status jnc::Session->clean(); $log->("MadScientist JNC Session Manager $VERSION ($RELDATE)"); # If we want to disconnect the current session, do it before we create a window if ($OPTS{disconnect}) { -x $NCSVC and jnc::Session->disconnect(); exit(0); } # If we want to uninstall, do it now if ($OPTS{uninstall}) { print "Uninstall Juniper Network Connect Removing $JNPATH. This operation *CANNOT BE UNDONE*. Are you sure you want to proceed (enter 'yes')? "; my $a = ; $a and $a eq "yes\n" or die "Stop.\n"; $log->("Uninstalling Juniper Network Connect\n"); system(qw(rm -rf), $JNPATH); $? == 0 or die "Failed.\n"; exit(0); } # Set up setup(\%OPTS); # Initialize the current session jnc::Session->update(1); # If the user wants to start with a certain profile, do that my $pf; if ($OPTS{profile}) { $pf = jnc::Profile->get($OPTS{profile}) or die "No such profile: $OPTS{profile}\n"; jnc::Session->set_active($pf->{pfid}); } else { my $pfn = jnc::Profile->get_default(); if (! $pfn) { # There's no default. If exactly one profile exists use that my @l = jnc::Profile->list(); $#l == 0 and $pfn = $l[0]; } $pf = jnc::Profile->get($pfn); $pf and jnc::Session->set_active($pf->{pfid}); } # If the connect option is given, do it now if ($OPTS{connect}) { jnc::Session->get_status() =~ /^Connect/ and die "A Juniper Network Connect VPN session is already active.\n"; $pf or die "Please specify a profile to use for the connection.\n"; # The /etc/resolv.conf file needs to exist or ncsvc will die -f '/etc/resolv.conf' or die "The /etc/resolv.conf file must exist ($!)\n"; # Turn off all buffering select STDERR; $| = 1; select STDOUT; $| = 1; my @pwds = get_passwd_tty($pf); print "Connecting to $pf->{host} ($pf->{realm}) ..."; jnc::Session->connect(@pwds); my $e = time() + 60; while (time() < $e) { jnc::Session->update(0); if (jnc::Session->get_status() eq 'Connected') { print " done\n"; exit(0); } sleep(2); print "."; } print " failed\n"; die "The Juniper Network Connect VPN session did not start.\n"; } # If we get here we're going to start a graphical session so init GTK # Do this before forking, so DISPLAY errors are caught early. Gtk2->init(); # If we want to run in the background, do that now if (! $OPTS{fg}) { # Change to a new process group setsid(); # Fork a new process my $pid = fork(); defined $pid && $pid >= 0 or die "fork: $!\n"; # In the parent we don't want to do anything: just exit $pid == 0 or _exit(0); # In the child, redirect IO since we're in the background # Closing these instead has unpleasant side-effects later open(my $N, '>', '/dev/null'); open(STDOUT, '>&', $N); open(STDERR, '>&', $N); open(STDIN, '<&', $N); close($N); } $log->("Started graphical session with PID $$"); # Create the main window window_create(); # Update the content window_update(); # Now make sure the application is installed properly. setup_app() or die "Failed to configure the Network Connect application.\n"; # Set a timer to go off once every second to update the window my $t = Glib::Timeout->add(1 * 1000, \&window_update, undef); # If there's no existing profile (first run?) let the user create one # This will happen when the user asks to connect #jnc::Session->get_status() ne 'Connected' && ! scalar(jnc::Profile->list()) # and window_edit(); Gtk2->main(); exit(0); =head1 NAME msjnc -- MadScientist JNC Session Manager =head1 SYNOPSIS msjnc [--help] [--version] msjnc [--fg] [--profile

] [--root] [--jarfile ] [--connect] msjnc [--disconnect] msjnc [--uninstall] =head1 DESCRIPTION This application starts and stops the Juniper Network Connect VPN sessions without using your web browser or requiring Java. It provides a standard GNU/Linux desktop application menu entry. It supports multiple profiles. It will install and configure the VPN software if necessary; however you must have obtained the software yourself. That software is not included. If the application detects an active Juniper Network Connect VPN session when it starts, it will begin to monitor that session and you can control it via the appliance. Also you can exit the application without shutting down the VPN session; however note that when the application is not running, no session change scripts will be invoked. =head2 Options =over 4 =item B<--help> This help text. =item B<--version> Show the version of the utility. =item B<--jarfile> I If Juniper Network Connect is not installed, install it from this JAR file. =item B<--profile> I

Make profile I

active, rather than the default profile. =item B<--root> Allow root to start the VPN. =item B<--connect> Start the VPN connection. Uses the profile specifed with C<--profile>, or the default profile. Does not start the GUI. =item B<--disconnect> Bring down any existing VPN connection. Does not start the GUI. =item B<--fg> Run in the foreground instead of the background. =item B<--uninstall> Delete the local configuration AND uninstall Juniper Network Connect You will have to reinstall it from scratch. =back =head1 PROFILES The application maintains a set of profiles that can be used to log into one or more Juniper Network Connect VPN services. Each profile consists of the following information: =over 4 =item B A name for the profile. You can choose this name as you like: it is not provided to the VPN server. It's only for local identification. This is required and must be unique between all profiles. =item B If this box is checked, then when the script detects that the session timed out it will automatically attempt to log back in using the same password provided before. If the login is not successful for any reason, then no further automatic login is attempted (until the next successful login and subsequent timeout). =item B The login username for the VPN server. This is required. =item B The password for the VPN server. If you use an RSA key you cannot provide this since your "password" changes constantly. Further, any passwords are stored I in the profile storage file. This is very insecure so I recommend that you do not specify a password as part of the profile. If the profile has no password, it will be requested each time you start the application. As long as the password is running and you don't change your profile, the password will be remembered until you exit the application. =item B If this is checked then the password will be assumed to use SecurID (or other randomization function) and will not ever be reused. If this is not checked then the password you enter will be re-used whenever you reconnect. It doesn't make sense to both enter a password here I check this box. It also doesn't make sense to check this box and also check the C box. =item B The VPN server name or IP address, or full URL. If you need to specify a port, append it to the name or IP address preceded by a colon (e.g., I:I). This is required. =item B Juniper Network Connect requires a "realm" identifier. When you enter the server information it will try to retrieve the realm from the server. Where this is not possible (for example, the server supports multiple realms or has a non-standard way of detecting the realm) you will need to enter the value by hand. =item B The proxy information is used only if you need a proxy. I'm not familiar with this, so I don't have much else to say. Note that the proxy password is treated the same way as the normal password (stored in plaintext, etc.) =item B The application allows you to define a script that will be invoked when the connection transitions from connected to disconnected, and vice versa. Note that this only works if the application is up and running when the operation occurs. If you exit the application then the script will not run. The script will be invoked with a single argument, either C or C. Additional information will be provided via the environment variables beginning with C: C, C, C, C, C, C, C, C, C, C. =back =head1 AUTHOR Paul Smith http://mad-scientist.net/juniper.html =head1 COPYRIGHT Copyright 2008-2013 Paul D. Smith This program is free software; you can redistribute it and/or modify it under th e terms of the Perl Artistic License or the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This program 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 General Public License for more details. If you do not have a copy of the GNU General Public License write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =cut