md5.pm revision 1.17 
1# ex:ts=8 sw=4:
2# $OpenBSD: md5.pm,v 1.17 2017/03/07 16:11:08 espie Exp $
3#
4# Copyright (c) 2003-2007 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18use strict;
19use warnings;
20
21package OpenBSD::digest;
22
23sub new
24{
25	my ($class, $filename) = @_;
26	$class = ref($class) || $class;
27	my $digest = $class->digest_file($filename);
28	bless \$digest, $class;
29}
30
31sub key
32{
33	my $self = shift;
34	return $$self;
35}
36
37sub write
38{
39	my ($self, $fh) = @_;
40	print $fh "\@", $self->keyword, " ", $self->stringize, "\n";
41}
42
43sub digest_file
44{
45	my ($self, $fname) = @_;
46	my $d = $self->algo;
47	eval {
48		$d->addfile($fname);
49	};
50	if ($@) {
51		$@ =~ s/\sat.*//;
52		die "can't compute ".$self->keyword." on $fname: $@";
53	}
54	return $d->digest;
55}
56
57sub fromstring
58{
59	my ($class, $arg) = @_;
60	$class = ref($class) || $class;
61	my $d = $class->unstringize($arg);
62	bless \$d, $class;
63}
64
65sub equals
66{
67	my ($a, $b) = @_;
68	return ref($a) eq ref($b) && $$a eq $$b;
69}
70
71package OpenBSD::sha;
72our @ISA=(qw(OpenBSD::digest));
73
74use Digest::SHA;
75use MIME::Base64;
76
77sub algo
78{
79	my $self = shift;
80
81	return Digest::SHA->new(256);
82}
83
84sub stringize
85{
86	my $self = shift;
87
88	return encode_base64($$self, '');
89}
90
91sub unstringize
92{
93	my ($class, $arg) = @_;
94	if ($arg =~ /^[0-9a-f]{64}$/i) {
95		return pack('H*', $arg);
96	}
97	return decode_base64($arg);
98}
99
100sub keyword
101{
102	return "sha";
103}
104
1051;
106