Skip to content

Commit

Permalink
add GSSAPI (Kerberos) authentication
Browse files Browse the repository at this point in the history 
This version is compatible with buggy Authen::SASL::Perl::GSSAPI which
always returns 1 from its need_step().
  • Loading branch information
@grawity
grawity committed Jul 19, 2020
1 parent c621716 commit 75c398b
Show file tree
Hide file tree
Showing 2 changed files with 131 additions and 1 deletion.
16 changes: 16 additions & 0 deletions doc/base.pod
View file
Original file line number Diff line number Diff line change
Expand Up @@ -507,6 +507,14 @@ The DIGEST-MD5 protocol's "digest-uri" values can be set using the --auth-extra

The CRAM-SHA1 authenticator requires the Digest::SHA module. This type has only been tested against a non-standard implementation on an Exim server and may therefore have some implementation deficiencies.

=item GSSAPI

The GSSAPI authenticator requires the Authen::SASL module, as well as one of Authen::SASL::XS or Authen::SASL::Cyrus for the libsasl bindings.

Although the most commonly used GSSAPI mechanisms are passwordless, the authenticator will prompt for a password regardless. However, it will not acquire initial credentials on your behalf if the mechanism doesn't already do so. For instance, Kerberos requires you to obtain a TGT using "kinit" before authenticating.

The GSSAPI service and host can be set using the --auth-extra option; for instance, "--auth-extra gss-serv-type=lmtp,gss-host=mail.example.com".

=item NTLM/SPA/MSN

These authenticators require the Authen::NTLM module. Note that there are two modules using the Authen::NTLM namespace on CPAN. The Mark Bush implementation (Authen/NTLM-1.03.tar.gz) is the version required by Swaks. This type has been tested against Exim, Communigate, and Exchange 2007.
Expand Down Expand Up @@ -555,6 +563,14 @@ The dmd5-host keyword is used by the DIGEST-MD5 authenticator and is used, in pa

The dmd5-serv-name keyword is used by the DIGEST-MD5 authenticator and is used, in part, to build the digest-uri-value string (see RFC2831)

=item gss-serv-type

The gss-serv-type keyword is used by the GSSAPI authenticator to specify the GSS service name (see RFC 4752).

=item gss-host

The gss-host keyword is used by the GSSAPI authenticator to specify the GSS hostname, which must match the server's fully qualified domain name (see RFC 4752).

=back

=item -am, --auth-map [auth-alias=auth-type[,...]]
Expand Down
116 changes: 115 additions & 1 deletion swaks
View file
Original file line number Diff line number Diff line change
Expand Up @@ -714,6 +714,12 @@ sub do_smtp_auth {
$auth_attempted = 1;
}
}
foreach my $type (@{$G::auth_map_t{'GSSAPI'}}) {
if ($btype eq $type) {
return(0) if (do_smtp_auth_gssapi($au, $ap, $type));
$auth_attempted = 1;
}
}
foreach my $type (@{$G::auth_map_t{'NTLM'}}) {
if ($btype eq $type) {
return(0) if (do_smtp_auth_ntlm($au, $ap, $type));
Expand All @@ -737,6 +743,103 @@ sub do_smtp_auth {
return $auth_attempted ? 4 : 2;
}

sub do_smtp_auth_gssapi {
my $u = shift; # auth user
my $p = shift; # auth password
my $as = shift; # auth string
my $ro = ''; # will store smtp output
my $ri = ''; # will store smtp input
my $c = ''; # will store Authen::SASL status
my $e = ''; # will store Authen::SASL errors
my @gssapi_uri = ();

if (exists($G::auth_extras{"GSS-SERV-TYPE"})) {
$gssapi_uri[0] = $G::auth_extras{"GSS-SERV-TYPE"};
} else {
$gssapi_uri[0] = 'smtp';
}
if (exists($G::auth_extras{"GSS-HOST"})) {
$gssapi_uri[1] = $G::auth_extras{"GSS-HOST"};
} else {
if ($G::link{type} eq 'socket-inet') {
$gssapi_uri[1] = $G::link{server};
} else {
# our local FQDN is the most sensible choice here, unlike in DIGEST-MD5
$gssapi_uri[1] = get_fqdn(hostname());
}
}

my $callbacks = { user => $u, pass => $p };
my $sasl = Authen::SASL->new(
debug => 0,
mechanism => 'GSSAPI',
callback => $callbacks,
);
my $sasl_client = $sasl->client_new(@gssapi_uri);
my $sasl_challenge;
my $sasl_response;

# RFC 4752 (SASL GSSAPI) specifically defines Kerberos 5 and not any
# other GSS-API mech. The mechanism always produces an initial client
# response.

$sasl_response = $sasl_client->client_start();
if (!length($sasl_response)) {
$c = $sasl_client->code();
$e = $sasl_client->error();
ptrans('12', "Error received from Authen::SASL sub-system (client_start): [$c] $e");
return(0);
}

# RFC 4954 (SMTP SASL) allows the initial response to optionally be
# part of AUTH if it fits in a SMTP line (i.e. maximum 738 byte raw
# response). If IR not sent, the server must produce an empty "334 ".

$ro = "AUTH $as ".eb64($sasl_response);
if (length($ro) > 998) {
# Too long for IR; use the normal mechanism. Expect empty challenge.
$ro = "AUTH $as";
do_smtp_gen($ro, '334', \$ri, '', '', $G::auth_showpt ? \&unencode_smtp : '')
|| return(0);
$ri =~ s/^....//;
if (length($ri) > 0) {
ptrans('12', "Cancelling SASL exchange, unexpected data from server");
return(0);
}
$ro = eb64($sasl_response);
}
# Otherwise carry the IR into the loop.

while (1) {
do_smtp_gen($ro, qr/(334|235)/, \$ri, '',
$G::auth_showpt ? "$sasl_response" : '',
$G::auth_showpt ? \&unencode_smtp : '')
|| return(0);

if (!$sasl_client->need_step()) {
last;
} elsif ($ri =~ /^235 /) {
# Authentication succeeded, but Authen::SASL::Perl's need_step() is lying to us.
# (Its Perl/GSSAPI.pm never calls set_success()...)
# The loop could be simplified into 'while need_step' if that were fixed.
if (ref($sasl_client) eq "Authen::SASL::Perl::GSSAPI") {
ptrans('12', "SASL: assuming no more steps!");
}
last;
} elsif ($ri =~ /^334 /) {
$ri =~ s/^....//;
$sasl_challenge = db64($ri);
($sasl_response) = $sasl_client->client_step($sasl_challenge);
$ro = eb64($sasl_response);
} else {
return(0);
}
}

return(0) if ($sasl_client->code() != 0);
return(1);
}

sub do_smtp_auth_ntlm {
my $u = shift; # auth user
my $p = shift; # auth password
Expand Down Expand Up @@ -1633,6 +1736,7 @@ sub load_dependencies {
req => [] },
auth_cram_md5 => { name => "AUTH CRAM-MD5", req => ['Digest::MD5'] },
auth_cram_sha1 => { name => "AUTH CRAM-SHA1", req => ['Digest::SHA'] },
auth_gssapi => { name => "AUTH GSSAPI", req => ['Authen::SASL'] },
auth_ntlm => { name => "AUTH NTLM", req => ['Authen::NTLM'] },
auth_digest_md5 => { name => "AUTH DIGEST-MD5", req => ['Authen::SASL'] },
dns => { name => "MX Routing", req => ['Net::DNS'] },
Expand Down Expand Up @@ -3358,7 +3462,7 @@ sub process_args {

# handle the --auth-map options plus our default mappings
foreach (split(/\s*,\s*/, get_arg('auth_map', $o)),"PLAIN=PLAIN","LOGIN=LOGIN",
"CRAM-MD5=CRAM-MD5","DIGEST-MD5=DIGEST-MD5",
"CRAM-MD5=CRAM-MD5","DIGEST-MD5=DIGEST-MD5","GSSAPI=GSSAPI",
"CRAM-SHA1=CRAM-SHA1","NTLM=NTLM","SPA=NTLM","MSN=NTLM")
{
if (/^([^=]+)=(.+)$/) {
Expand Down Expand Up @@ -3415,6 +3519,8 @@ sub process_args {
ptrans(12, avail_str("auth_cram_md5")) if ($auth_t ne 'ANY');
} elsif ($G::auth_map_f{$type} eq 'CRAM-SHA1' && !avail("auth_cram_sha1")) {
ptrans(12, avail_str("auth_cram_sha1")) if ($auth_t ne 'ANY');
} elsif ($G::auth_map_f{$type} eq 'GSSAPI' && !avail("auth_gssapi")) {
ptrans(12, avail_str("auth_gssapi")) if ($auth_t ne 'ANY');
} elsif ($G::auth_map_f{$type} eq 'NTLM' && !avail("auth_ntlm")) {
ptrans(12, avail_str("auth_ntlm")) if ($auth_t ne 'ANY');
} elsif ($G::auth_map_f{$type} eq 'DIGEST-MD5' && !avail("auth_digest_md5")) {
Expand Down Expand Up @@ -3764,6 +3870,14 @@ sub get_date_string {
$o);
}

sub get_fqdn {
my $h = shift;

my @r = gethostbyname($h);

return $r[0] // $h;
}

# partially Cribbed from "Programming Perl" and MIME::Base64 v2.12
sub db64 {
my $s = shift;
Expand Down

0 comments on commit 75c398b

Please sign in to comment.