1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Getopt::Long; 7use Sys::Hostname; 8 9use IO::Socket::INET; 10 11use GSSAPI; 12use MIME::Base64; 13 14 15my %opt; 16 17# 18# Arguments: 19# kname syntax is prodid@hostname or prodid@servicename 20# e.g.: host@server1 21# e.g.: mqm@mqserver1 22# 23 24unless (GetOptions(\%opt, qw(keytabfile=s hostname=s port=s))) { 25 exit(1); 26} 27 28if(! $opt{port}) { 29 warn "$0: -port not specified, defaulting to 10000\n"; 30 $opt{port} = 10000; 31} 32 33if(! $opt{hostname}) { 34 $opt{hostname} = hostname(); 35 warn "$0: -name not specified, using hostname result [" . $opt{hostname} . "]\n"; 36} 37warn "$0: using [" . $opt{hostname} .':' .$opt{port} . "]\n"; 38# 39# Servers need keytab files, the only standard so far is /etc/krb5.keytab. 40# That's the file meant to contain keys for the local machine. It is readable 41# only by root for security reasons. In this case the name is host@machinename. 42# 43 44$ENV{KRB5_KTNAME} = "FILE:" . $opt{keytabfile}; 45if (! -r $opt{keytabfile}) { 46 die "Cannot read ". $opt{keytabfile} .": $!"; 47} 48 49print "SERVER set environment variable KRB5_KTNAME to " . $ENV{KRB5_KTNAME} . "\n"; 50 51my $listen_socket = IO::Socket::INET->new ( 52 Listen => 16, 53 LocalHost => $opt{hostname}, 54 LocalPort => $opt{port}, 55 ReuseAddr => 1, 56 Proto => 'tcp', 57 ); 58 59die "Unable to create listen socket: $!" unless $listen_socket; 60 61print "Listening on port $opt{port} ...\n"; 62 63my $error = 0; 64 65while (! $error) { 66 67 my $server_context; 68 print "\nSERVER::waiting for request ...\n"; 69 my $client_socket = $listen_socket->accept(); 70 unless ($client_socket) { 71 warn "SERVER::accept failed: $!"; 72 next; 73 } 74 75 print "SERVER::accepted connection from client ...\n"; 76 my $gss_input_token = <$client_socket>; 77 78 $gss_input_token = decode_base64($gss_input_token); 79 print "SERVER::received token (length is " . length($gss_input_token) . "):\n"; 80 81 if (length($gss_input_token) ) { 82 my $status = GSSAPI::Context::accept( 83 $server_context, 84 GSS_C_NO_CREDENTIAL, 85 $gss_input_token, 86 GSS_C_NO_CHANNEL_BINDINGS, 87 my $gss_client_name, 88 my $out_mech, 89 my $gss_output_token, 90 my $out_flags, 91 my $out_time, 92 my $gss_delegated_cred); 93 94 $status or gss_exit("Unable to accept security context", $status); 95 my $client_name; 96 $status = $gss_client_name->display($client_name); 97 $status or gss_exit("Unable to display client name", $status); 98 print "SERVER::authenticated client name is $client_name\n" if $client_name; 99 100 if($gss_output_token) { 101 print "SERVER::Have mutual token to send ...\n"; 102 print "SERVER::GSS token size: " . length($gss_output_token) . "\n"; 103 104 # 105 # $gss_output_token is binary data 106 # 107 108 my $enc_token = encode_base64($gss_output_token, ''); 109 110 print $client_socket "$enc_token\n"; 111 print "SERVER::sent token (length is " . length($gss_output_token) . ")\n"; 112 } 113 } 114 # $server_context->DESTROY() if $server_context; 115} 116 117print "SERVER::exiting after error\n"; 118 119################################################################################ 120 121sub gss_exit { 122 my $errmsg = shift; 123 my $status = shift; 124 125 my @major_errors = $status->generic_message(); 126 my @minor_errors = $status->specific_message(); 127 128 print STDERR "$errmsg:\n"; 129 foreach my $s (@major_errors) { 130 print STDERR " MAJOR::$s\n"; 131 } 132 foreach my $s (@minor_errors) { 133 print STDERR " MINOR::$s\n"; 134 } 135 return 1; 136} 137