root/examples/gss-client.pl

#!/usr/bin/perl

use strict;
use warnings;

use lib "/afs/acm.uiuc.edu/user/cclausen/perl/lib/perl/5.8.7";

use Getopt::Long;
use IO::Socket::INET;
use MIME::Base64;
use GSSAPI;

my %opt;

unless(GetOptions(\%opt, qw(prodid=s hostname=s port=s mutual))) {
  print "$0 needs arguments, provide at least -prodid and -hostname, optionally -port (defauly 10000) or -mutual (for two sided authentication)\n";
  exit(1);
}

if(! $opt{hostname}) {
  die "$0: must specify -hostname\n";
}

if(! $opt{prodid}) {
  die "$0: must specify -prodid\n";
}

if(! $opt{port}) {
  warn "$0: -port not specified, defaulting to 10000\n";
  $opt{port} = 10000;
}

if(! $opt{prodid}) {
  $opt{prodid} = "host";
}

warn "$0: using [$opt{prodid}\@$opt{hostname}:$opt{port}]\n";


#
# GSSAPI::Name->import produces $gss_server_name
# which is then passed in to GSSAPI::Context::init
# $gss_server_name represents the principcal name
# of the app server to which we are authenticating
#

my $server_name = "$opt{prodid}\@$opt{hostname}";
my $status = GSSAPI::Name->import(my $gss_server_name, $server_name, gss_nt_service_name);
$status || gss_exit("CLIENT::Unable to import server name: $server_name", $status);

$status = $gss_server_name->display(my $display_name, my $type);
print "CLIENT::principal [$server_name] means going to communicate with server name [$display_name]\n";

my $gss_input_token = GSS_C_NO_BUFFER;

my $socket = IO::Socket::INET->new
  (
   PeerAddr                 => $opt{hostname},
   PeerPort                 => $opt{port},
   Proto                    => 'tcp',
   Type                     => SOCK_STREAM,
  );

die "socket/connect: $!\n" unless ($socket);

#
# The main purpose of GSSAPI::Context::init is to produce
# an authentication token ($gss_output_token) which will
# be sent by the app client to app server. Note the output
# is binary data.
#

my $gss_auth_flags;
if($opt{mutual}) {
  $gss_auth_flags = GSS_C_MUTUAL_FLAG;
} else {
  $gss_auth_flags = 0;
}

my $client_context;

my $counter = 0;
my $error = 0;

do {
    $counter++;
    my $gss_output_token;

    $status = GSSAPI::Context::init($client_context,           # output context
                                    GSS_C_NO_CREDENTIAL,
                                    $gss_server_name,          # authenticate to this name
                                    GSS_C_NO_OID,              # use default mechanism (krb5)
                                    $gss_auth_flags,           # input flags
                                    0,                         # input time
                                    GSS_C_NO_CHANNEL_BINDINGS, # no channel binding
                                    $gss_input_token,          # input token
                                    my $out_mech,
                                    $gss_output_token,
                                    my $out_flags,
                                    my $out_time);

    $status || gss_exit("CLIENT::Unable to initialize security context", $status);

    print "CLIENT::gss_init_sec_context success\n";

    # The GSS protocol can do mutual authentication. If this is requested, the token 
    # that we generate in the first pass will indicate this to the server. The major 
    # status will have the GSS_S_CONTINUE_NEEDED bit set to indicate that we are 
    # expecting a reply with a server identity token. This loop will continue until 
    # that bit is no longer set. It should go through only once (non-mutual) or twice
    # (mutual). 

    if ($counter == 1) {
        print "CLIENT::going to identify client to server\n";
    } elsif ($counter == 2) {
        print "CLIENT::confirmed server identity from mutual token\n";
        $gss_server_name->display(my $server_name, my $type);
        print "CLIENT::authenticated server name is $server_name\n" if $server_name;

    } else {
        print "CLIENT::iteration [$counter] successful, but should not be here\n";
    }

    if($gss_output_token) {
        print "CLIENT::have token to send ...\n";
        print "CLIENT::GSS token length is " . length($gss_output_token) . "\n";

        #
        # $gss_output_token is binary data
        #

        print $socket encode_base64($gss_output_token, '') . "\n";
        print "CLIENT::sent token to server\n";
    }

    if ($status->major & GSS_S_CONTINUE_NEEDED) {
        print "CLIENT::Mutual auth requested ...\n";
        $gss_input_token = <$socket>;
        if ($gss_input_token) {
            print "CLIENT::got mutual auth token from server\n";
            $gss_input_token = decode_base64($gss_input_token);
            print "CLIENT::mutual auth token length is " . length($gss_input_token) . "\n";
        } else {
            print "CLIENT::server did not send needed continue token back\n";
            $error = 1;
        }
    }
} while (!$error and $status->major & GSS_S_CONTINUE_NEEDED);

$socket->shutdown(2);

exit(0);

################################################################################

sub gss_exit {
  my $errmsg = shift;
  my $status = shift;

  my @major_errors = $status->generic_message();
  my @minor_errors = $status->specific_message();
 
  print STDERR "$errmsg:\n";
  foreach my $s (@major_errors) {
    print STDERR "  MAJOR::$s\n";
  }
  foreach my $s (@minor_errors) {
    print STDERR "  MINOR::$s\n";
  }
  exit(1);
}