This file is indexed.

/usr/lib/perl5/Authen/DecHpwd.pm is in libauthen-dechpwd-perl 2.006-1build1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
=head1 NAME

Authen::DecHpwd - DEC VMS password hashing

=head1 SYNOPSIS

	use Authen::DecHpwd qw(
		UAI_C_AD_II UAI_C_PURDY UAI_C_PURDY_V UAI_C_PURDY_S
		lgi_hpwd
	);

	$hash = lgi_hpwd("JRANDOM", "PASSWORD", UAI_C_PURDY_S, 1234);

	use Authen::DecHpwd qw(vms_username vms_password);

	$username = vms_username($username);
	$password = vms_password($password);

=head1 DESCRIPTION

This module implements the C<SYS$HASH_PASSWORD> password hashing function
from VMS (also known as C<LGI$HPWD>), and some associated VMS username
and password handling functions.

The password hashing function is implemented in XS, with a hideously
slow pure Perl backup version for systems that can't handle XS.

=cut

package Authen::DecHpwd;

{ use 5.006; }
use warnings;
use strict;

use Digest::CRC 0.14 qw(crc32);

our $VERSION = "2.006";

use parent "Exporter";
our @EXPORT_OK = qw(
	UAI_C_AD_II UAI_C_PURDY UAI_C_PURDY_V UAI_C_PURDY_S
	lgi_hpwd
	vms_username vms_password
);

eval { local $SIG{__DIE__};
	require XSLoader;
	XSLoader::load(__PACKAGE__, $VERSION);
};

=head1 FUNCTIONS

=over

=item UAI_C_AD_II

=item UAI_C_PURDY

=item UAI_C_PURDY_V

=item UAI_C_PURDY_S

These constants are used to identify the four password hashing algorithms
used by VMS.  They are the C<UAI$C_> constants in VMS.

C<UAI_C_AD_II> refers to a 32-bit CRC algorithm.  The CRC polynomial used
is the IEEE CRC-32 polynomial, as used in Ethernet, and in this context
is known as "AUTODIN-II".  The hash is merely the CRC of the password.

C<UAI_C_PURDY>, C<UAI_C_PURDY_V>, and C<UAI_C_PURDY_S> refer to successive
refinements of an algorithm based on Purdy polynomials.  All of these
algorithms use the salt and username parameters as salt, use the whole
password, and return an eight-byte (64-bit) hash.  The main part
of the algorithm, the Purdy polynomial, is identical in all three.
They differ in the pre-hashing, particularly in the treatment of the
username parameter.

In C<UAI_C_PURDY> the username is truncated or space-padded to 12 characters
before being hashed in.  C<UAI_C_PURDY_V> accepts a variable-length username.
C<UAI_C_PURDY_S> accepts a variable-length username and also includes the
password length in the hash.  C<UAI_C_PURDY_S> also does some extra bit
rotations when hashing in the username and password strings, in order
to avoid aliasing.

=cut

use constant UAI_C_AD_II => 0;
use constant UAI_C_PURDY => 1;
use constant UAI_C_PURDY_V => 2;
use constant UAI_C_PURDY_S => 3;

=item lgi_hpwd(USERNAME, PASSWORD, ALGORITHM, SALT)

This is the C<SYS$HASH_PASSWORD> function from VMS (also known as
C<LGI$HPWD>), but with the parameters in a different order.  It hashes
the PASSWORD string in a manner determined by the other parameters,
and returns the hash as a string of bytes.

ALGORITHM determines which hashing algorithm will be used.  It must
be the value of one of the algorithm constants supplied by this module
(see above).

SALT must be an integer in the range [0, 2^16).  It modifies the hashing
so that the same password does not always produce the same hash.

USERNAME is a string that is used as more salt.  In VMS it is the username
of the account to which the password controls access.

VMS usernames and passwords are constrained in character set and
length, and are case-insensitive.  This function does not enforce
these restrictions, nor perform canonicalisation.  If restrictions
and canonicalisation are desired then they must be applied separately.
The functions C<vms_username> and C<vms_password> described below may
be useful.

=cut

unless(defined &lgi_hpwd) { { local $SIG{__DIE__}; eval q{

use warnings;
use strict;

use Data::Integer 0.003 qw(
	natint_bits
	uint_shl uint_shr uint_rol
	uint_and uint_or
	uint_madd uint_cadd
);
use Scalar::String 0.000 qw(sclstr_is_downgraded sclstr_downgraded);

my $u32_mask = 0xffffffff;

sub _u32_shl($$) {
	if(natint_bits == 32) {
		return &uint_shl;
	} else {
		return uint_and(&uint_shl, $u32_mask);
	}
}

*_u32_shr = \&uint_shr;

*_u32_and = \&uint_and;

sub _u32_rol($$) {
	if(natint_bits == 32) {
		return &uint_rol;
	} else {
		return $_[0] if $_[1] == 0;
		return uint_and(uint_or(uint_shl($_[0], $_[1]),
					uint_shr($_[0], 32-$_[1])),
				$u32_mask);
	}
}

sub _u32_madd($$) { uint_and(&uint_madd, $u32_mask) }

sub _u32_cadd($$$) {
	if(natint_bits == 32) {
		return &uint_cadd;
	} else {
		my(undef, $val) = uint_cadd($_[0], $_[1], $_[2]);
		return (uint_and(uint_shr($val, 32), 1),
			uint_and($val, $u32_mask));
	}
}

my $u16_mask = 0xffff;

sub _u16_madd($$) { uint_and(&uint_madd, $u16_mask) }

my $u8_mask = 0xff;

sub _u8_madd($$) { uint_and(&uint_madd, $u8_mask) }

sub _addUnalignedWord($$) {
	$_[0] = pack("v", _u16_madd(unpack("v", $_[0]), $_[1]));
}

use constant _PURDY_USERNAME_LENGTH => 12;

use constant _A => 59;
use constant _DWORD_MAX => 0xffffffff;
use constant _P_D_LOW => _DWORD_MAX - _A + 1;
use constant _P_D_HIGH => _DWORD_MAX;

use constant _N0 => 0xfffffd;
use constant _N1 => 0xffffc1;
use constant _Na => 448;
use constant _Nb => 37449;

use constant _MASK => 7;

use constant _C1 => pack("VV", 0xffffffad, 0xffffffff);
use constant _C2 => pack("VV", 0xffffff4d, 0xffffffff);
use constant _C3 => pack("VV", 0xfffffeff, 0xffffffff);
use constant _C4 => pack("VV", 0xfffffebd, 0xffffffff);
use constant _C5 => pack("VV", 0xfffffe95, 0xffffffff);

sub _PQMOD_R0($) {
	my($low, $high) = unpack("VV", $_[0]);
	if($high == _P_D_HIGH && $low >= _P_D_LOW) {
		$_[0] = pack("VV", _u32_madd($low, _A), 0);
	}
}

sub _ROL1($) { $_[0] = pack("V", _u32_rol(unpack("V", $_[0]), 1)); }

sub _QROL1($) {
	_ROL1(substr($_[0], 0, 4));
	_ROL1(substr($_[0], 4, 4));
}

sub _EMULQ($$$) {
	my($a, $b, undef) = @_;
	my $hi = _u32_shr($a, 16) * _u32_shr($b, 16);
	my $lo = _u32_and($a, 0xffff) * _u32_and($b, 0xffff);
	my $carry;
	my $p = _u32_shr($a, 16) * _u32_and($b, 0xffff);
	($carry, $lo) = _u32_cadd($lo, _u32_shl($p, 16), 0);
	($carry, $hi) = _u32_cadd($hi, _u32_shr($p, 16), $carry);
	$p = _u32_and($a, 0xffff) * _u32_shr($b, 16);
	($carry, $lo) = _u32_cadd($lo, _u32_shl($p, 16), 0);
	($carry, $hi) = _u32_cadd($hi, _u32_shr($p, 16), $carry);
	$_[2] = pack("VV", $lo, $hi);
}

sub _PQADD_R0($$$) {
	my($u, $y, undef) = @_;
	my($ulo, $uhi) = unpack("VV", $u);
	my($ylo, $yhi) = unpack("VV", $y);
	my($carry, $rlo, $rhi);
	($carry, $rlo) = _u32_cadd($ulo, $ylo, 0);
	($carry, $rhi) = _u32_cadd($uhi, $yhi, $carry);
	while($carry) {
		($carry, $rlo) = _u32_cadd($rlo, _A, 0);
		($carry, $rhi) = _u32_cadd($rhi, 0, $carry);
	}
	$_[2] = pack("VV", $rlo, $rhi);
}

sub _COLLAPSE_R2($$$) {
	my($s, undef, $isPurdyS) = @_;
	for(my $p = length($s); $p != 0; $p--) {
		my $pp = $p & _MASK;
		substr($_[1], $pp, 1) = pack("C",
			_u8_madd(unpack("C", substr($_[1], $pp, 1)),
				unpack("C", substr($s, -$p, 1))));
		if($isPurdyS && $pp == _MASK) { _QROL1($_[1]); }
	}
}

sub _PQLSH_R0($$) {
	my($u, undef) = @_;
	my($ulo, $uhi) = unpack("VV", $u);
	my $stack = pack("VV", 0, 0);
	my $x = pack("VV", 0, 0);
	_EMULQ($uhi, _A, $stack);
	$x = pack("VV", 0, $ulo);
	_PQADD_R0($x, $stack, $_[1]);
}

sub _PQMUL_R2($$$) {
	my($u, $y, undef) = @_;
	my($ulo, $uhi) = unpack("VV", $u);
	my($ylo, $yhi) = unpack("VV", $y);
	my $stack = pack("VV", 0, 0);
	my $part1 = pack("VV", 0, 0);
	my $part2 = pack("VV", 0, 0);
	my $part3 = pack("VV", 0, 0);
	_EMULQ($uhi, $yhi, $stack);
	_PQLSH_R0($stack, $part1);
	_EMULQ($uhi, $ylo, $stack);
	_EMULQ($ulo, $yhi, $part2);
	_PQADD_R0($stack, $part2, $part3);
	_PQADD_R0($part1, $part3, $stack);
	_PQLSH_R0($stack, $part1);
	_EMULQ($ulo, $ylo, $stack);
	_PQADD_R0($part1, $stack, $_[2]);
}

sub _PQEXP_R3($$$) {
	my($u, $n, undef) = @_;
	my $y = pack("VV", 0, 0);
	my $z = pack("VV", 0, 0);
	my $z1 = pack("VV", 0, 0);
	my $yok = 0;
	$z = $u;
	while($n != 0) {
		if($n & 1) {
			if($yok) {
				_PQMUL_R2($y, $z, $_[2]);
			} else {
				$_[2] = $z;
				$yok = 1;
			}
			if($n == 1) { return; }
			$y = $_[2];
		}
		$n >>= 1;
		$z1 = $z;
		_PQMUL_R2($z1, $z1, $z);
	}
	$_[2] = pack("VV", 1, 0);
}

sub _Purdy($) {
	my $t1 = pack("VV", 0, 0);
	my $t2 = pack("VV", 0, 0);
	my $t3 = pack("VV", 0, 0);

	_PQEXP_R3($_[0], _Na, $t1);
	_PQEXP_R3($t1, _Nb, $t2);
	_PQEXP_R3($_[0], (_N0 - _N1), $t1);
	_PQADD_R0($t1, _C1, $t3);
	_PQMUL_R2($t2, $t3, $t1);

	_PQMUL_R2($_[0], _C2, $t2);
	_PQADD_R0($t2, _C3, $t3);
	_PQMUL_R2($_[0], $t3, $t2);
	_PQADD_R0($t2, _C4, $t3);

	_PQADD_R0($t1, $t3, $t2);
	_PQMUL_R2($_[0], $t2, $t1);
	_PQADD_R0($t1, _C5, $_[0]);

	_PQMOD_R0($_[0]);
}

sub lgi_hpwd($$$$) {
	my($username, $password, $alg, $salt) = @_;
	if($alg > UAI_C_PURDY_S) {
		die "algorithm value $alg is not recognised";
	}
	$salt = uint_and($salt, 0xffff);
	# This string downgrading is necessary for correct behaviour on
	# perl 5.6 and 5.8.  It is not necessary on 5.10, but will still
	# slightly improve performance.
	$username = sclstr_downgraded($username, 1);
	$password = sclstr_downgraded($password, 1);
	die "input must contain only octets"
		unless sclstr_is_downgraded($username) &&
			sclstr_is_downgraded($password);
	if($alg == UAI_C_AD_II) {
		return pack("VV", Digest::CRC::crc32($password)^0xffffffff, 0);
	}
	my $isPurdyS = $alg == UAI_C_PURDY_S;
	my $output = pack("VV", 0, 0);
	if($alg == UAI_C_PURDY) {
		$username .= " " x 12;
		$username = substr($username, 0, _PURDY_USERNAME_LENGTH);
	} elsif($alg == UAI_C_PURDY_S) {
		_addUnalignedWord(substr($output, 0, 2), length($password));
	}
	_COLLAPSE_R2($password, $output, $isPurdyS);
	_addUnalignedWord(substr($output, 3, 2), $salt);
	_COLLAPSE_R2($username, $output, $isPurdyS);
	_Purdy($output);
	return $output;
}

1;

}; } die $@ if $@ ne "" }

=item vms_username(USERNAME)

Checks whether the USERNAME string matches VMS username syntax, and
canonicalises it.  VMS username syntax is 1 to 31 characters from
case-insensitive alphanumerics, "B<_>", and "B<$>".  If the string has
correct username syntax then the username is returned in canonical form
(uppercase).  If the string is not a username then C<undef> is returned.

=cut

sub vms_username($) {
	return $_[0] =~ /\A[_\$0-9A-Za-z]{1,31}\z/ ? uc("$_[0]") : undef;
}

=item vms_password(PASSWORD)

Checks whether the PASSWORD string is an acceptable VMS password,
and canonicalises it.  VMS password syntax is 1 to 32 characters from
case-insensitive alphanumerics, "B<_>", and "B<$>".  If the string is
an acceptable password then the password is returned in canonical form
(uppercase).  If the string is not an acceptable password then C<undef>
is returned.

=cut

sub vms_password($) {
	return $_[0] =~ /\A[_\$0-9A-Za-z]{1,32}\z/ ? uc("$_[0]") : undef;
}

=back

=head1 SEE ALSO

L<VMS::User>

=head1 AUTHOR

The original C implementation of C<LGI$HPWD> was written by Shawn Clifford.
The code has since been developed by Davide Casale, Mario Ambrogetti,
Terence Lee, Jean-loup Gailly, Solar Designer, and Andrew Main (Zefram).

Mike McCauley <mikem@open.com.au> created the first version of
C<Authen::DecHpwd>, establishing the Perl interface.  This was based on
Shawn Clifford's code without the later developments.

Andrew Main (Zefram) <zefram@fysh.org> created a new C<Authen::DecHpwd>
based on the more developed C code presently used, and added ancillary
functions.

=head1 COPYRIGHT

Copyright (C) 2002 Jean-loup Gailly <http://gailly.net>

Based in part on code from John the Ripper, Copyright (C) 1996-2002
Solar Designer

Copyright (C) 2006, 2007, 2009, 2010, 2011
Andrew Main (Zefram) <zefram@fysh.org>

=head1 LICENSE

This module 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 2 of the License, or (at your
option) any later version.

=cut

1;