package Echolot::Tools; # (c) 2002 Peter Palfrader # $Id: Tools.pm,v 1.11 2002/10/25 10:47:54 weasel Exp $ # =pod =head1 Name Echolot::Tools - Tools for echolot =head1 DESCRIPTION =cut use strict; use Carp qw{cluck}; use HTML::Template; use Digest::MD5 qw{}; use GnuPG::Interface; sub hash($) { my ($data) = @_; ($data) = $data =~ m/(.*)/s; # untaint my $hash = Digest::MD5::md5_hex($data); return $hash; }; sub make_random($;%) { my ($length, %args) = @_; my $random; open (FH, Echolot::Config::get()->{'dev_random'}) or cluck("Cannot open ".Echolot::Config::get()->{'dev_random'}." for reading: $!"), return 0; read(FH, $random, $length) or cluck("Cannot read from ".Echolot::Config::get()->{'dev_random'}.": $!"), return 0; close (FH) or cluck("Cannot close ".Echolot::Config::get()->{'dev_random'}.": $!"), return 0; $random = unpack('H*', $random) if ($args{'armor'} == 1); return $random; }; sub make_mac($) { my ($token) = @_; my $mac = hash($token . Echolot::Globals::get()->{'storage'}->get_secret() ); return $mac; }; sub makeShortNumHash($) { my ($text) = @_; my $hash = Echolot::Tools::make_mac($text); $hash = substr($hash, 0, 4); my $sum = hex($hash); return $sum; }; sub verify_mac($$) { my ($token, $mac) = @_; return (hash($token . Echolot::Globals::get()->{'storage'}->get_secret() ) eq $mac); }; sub make_address($) { my ($subsystem) = @_; my $token = $subsystem.'='.time(); my $hash = hash($token . Echolot::Globals::get()->{'storage'}->get_secret() ); my $cut_hash = substr($hash, 0, Echolot::Config::get()->{'hash_len'}); my $complete_token = $token.'='.$cut_hash; my $address = Echolot::Config::get()->{'recipient_delimiter'} ne ''? Echolot::Config::get()->{'my_localpart'}. Echolot::Config::get()->{'recipient_delimiter'}. $complete_token. '@'. Echolot::Config::get()->{'my_domain'} : Echolot::Config::get()->{'my_localpart'}. '@'. Echolot::Config::get()->{'my_domain'}. '('. $complete_token. ')'; return $address; }; sub verify_address_tokens($) { my ($address) = @_; my ($type, $timestamp, $received_hash); if (Echolot::Config::get()->{'recipient_delimiter'} ne '') { my $delimiter = quotemeta( Echolot::Config::get()->{'recipient_delimiter'}); ($type, $timestamp, $received_hash) = $address =~ /$delimiter (.*) = (\d+) = ([0-9a-f]+) @/x or ($type, $timestamp, $received_hash) = $address =~ /\( (.*) = (\d+) = ([0-9a-f]+) \)/x or cluck("Could not parse to header '$address'"), return undef; } else { ($type, $timestamp, $received_hash) = $address =~ /\( (.*) = (\d+) = ([0-9a-f]+) \)/x or cluck("Could not parse to header '$address'"), return undef; }; my $token = $type.'='.$timestamp; my $hash = Echolot::Tools::hash($token . Echolot::Globals::get()->{'storage'}->get_secret() ); my $cut_hash = substr($hash, 0, Echolot::Config::get()->{'hash_len'}); ($cut_hash eq $received_hash) or cluck("Hash mismatch in '$address'"), return undef; return { timestamp => $timestamp, token => $type }; }; sub send_message(%) { my (%args) = @_; defined($args{'To'}) or cluck ('No recipient address given'), return 0; $args{'Subject'} = '' unless (defined $args{'Subject'}); $args{'Body'} = '' unless (defined $args{'Body'}); $args{'From_'} = Echolot::Config::get()->{'my_localpart'}. '@'. Echolot::Config::get()->{'my_domain'}; if (defined $args{'Token'}) { $args{'From'} = make_address( $args{'Token'} ); } else { $args{'From'} = $args{'From_'}; }; $args{'Subject'} = 'none' unless (defined $args{'Subject'}); my @lines = map { $_."\n" } split (/\r?\n/, $args{'Body'}); open(SENDMAIL, '|'.Echolot::Config::get()->{'sendmail'}.' -f '.$args{'From_'}.' -t') or cluck("Cannot run sendmail: $!"), return 0; printf SENDMAIL "From: %s\n", $args{'From'}; printf SENDMAIL "To: %s\n", $args{'To'}; printf SENDMAIL "Subject: %s\n", $args{'Subject'}; printf SENDMAIL "\n"; for my $line (@lines) { print SENDMAIL $line; }; close SENDMAIL; return 1; }; sub make_monthname($) { my ($month) = @_; my @MON = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}; return $MON[$month]; }; sub make_dayname($) { my ($day) = @_; my @WDAY = qw{Sun Mon Tue Wed Thu Fri Sat}; return $WDAY[$day]; }; sub date822($) { my ($date) = @_; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($date); # 14 Aug 2002 17:11:12 +0100 return sprintf("%s, %02d %s %d %02d:%02d:%02d +0000", make_dayname($wday), $mday, make_monthname($mon), $year + 1900, $hour, $min, $sec); }; sub write_meta_information($%) { my ($file, %data) = @_; return 1 unless Echolot::Config::get()->{'write_meta_files'}; $file .= Echolot::Config::get()->{'meta_extension'}; open (F, ">$file") or cluck ("Cannot open $file: $!"), return 0; if (defined $data{'Expires'}) { my $date = date822($data{'Expires'}); print F "Expires: $date\n"; }; close(F); return 1; }; sub write_HTML_file($$;$%) { my ($file, $template_file, $expire, %templateparams) = @_; my $template = HTML::Template->new( filename => $template_file, strict => 0, die_on_bad_params => 0, global_vars => 1 ); $template->param ( %templateparams ); $template->param ( CURRENT_TIMESTAMP => scalar gmtime() ); $template->param ( SITE_NAME => Echolot::Config::get()->{'sitename'} ); $template->param ( separate_rlist => Echolot::Config::get()->{'separate_rlists'} ); $template->param ( combined_list => Echolot::Config::get()->{'combined_list'} ); $template->param ( thesaurus => Echolot::Config::get()->{'thesaurus'} ); $template->param ( version => Echolot::Globals::get()->{'version'} ); $template->param ( expires => date822( time + $expire )); open(F, '>'.$file) or cluck("Cannot open $file: $!\n"), return 0; print F $template->output() or cluck("Cannot print to $file: $!\n"), return 0; close (F) or cluck("Cannot close $file: $!\n"), return 0; if (defined $expire) { write_meta_information($file, Expires => time + $expire) or cluck ("Error while writing meta information for $file"), return 0; }; return 1; }; sub crypt_symmetrically($$) { my ($msg, $direction) = @_; ($direction eq 'encrypt' || $direction eq 'decrypt') or cluck("Wrong argument direction '$direction' passed to crypt_symmetrically."), return undef; my $GnuPG = new GnuPG::Interface; $GnuPG->call( Echolot::Config::get()->{'gnupg'} ) if (Echolot::Config::get()->{'gnupg'}); $GnuPG->options->hash_init( armor => 1, homedir => Echolot::Config::get()->{'gnupghome'} ); $GnuPG->options->meta_interactive( 0 ); $GnuPG->passphrase( Echolot::Globals::get()->{'storage'}->get_secret() ); my ( $stdin_fh, $stdout_fh, $stderr_fh, $status_fh ) = ( IO::Handle->new(), IO::Handle->new(), IO::Handle->new(), IO::Handle->new(), ); my $handles = GnuPG::Handles->new ( stdin => $stdin_fh, stdout => $stdout_fh, stderr => $stderr_fh, status => $status_fh ); my $pid = $direction eq 'encrypt' ? $GnuPG->encrypt_symmetrically( handles => $handles ) : $GnuPG->decrypt( handles => $handles ); print $stdin_fh $msg; close($stdin_fh); my $stdout = join '', <$stdout_fh>; close($stdout_fh); my $stderr = join '', <$stderr_fh>; close($stderr_fh); my $status = join '', <$status_fh>; close($status_fh); waitpid $pid, 0; if ($direction eq 'encrypt') { (($status =~ /^^\[GNUPG:\] BEGIN_ENCRYPTION\s/m) && ($status =~ /^^\[GNUPG:\] END_ENCRYPTION\s/m)) or cluck("GnuPG status '$status' didn't indicate message was encrypted correctly (stderr: $stderr). Returning\n"), return undef; } elsif ($direction eq 'decrypt') { (($status =~ /^^\[GNUPG:\] BEGIN_DECRYPTION\s/m) && ($status =~ /^^\[GNUPG:\] DECRYPTION_OKAY\s/m) && ($status =~ /^^\[GNUPG:\] END_DECRYPTION\s/m)) or cluck("GnuPG status '$status' didn't indicate message was decrypted correctly (stderr: $stderr). Returning\n"), return undef; }; my $result = $stdout; $result =~ s,^Version: .*$,Version: N/A,m; return $result; }; 1; # vim: set ts=4 shiftwidth=4: