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