in reply to Temporarily Obscuring a Lottery Draw

Thank you all for your wonderful suggestions. I'm going to try following Perlbotics' suggestions regarding md5ing the pairs and storing that. If that doesn't work (either people complain that this info is on my machine or someone actually bothers to try to crack it), I'll follow BrowserUK's suggestion. The local third party approach mr_mischief suggests is clearly unacceptable, as everyone here is quite fond of presents. And of course, I'm tempted to try Fletch's solution just because. I mean, damn.

For those who are interested, I've included my final source. There's support for mr_mischief's third party by storing an email address in $authority. Of course, the e-mail credentials file is for a Santa-only account and is chmodded to 600.

#!/usr/bin/perl -w use strict; use List::Util qw(shuffle); use Digest::MD5 qw(md5_hex); use Net::SMTP::TLS; # Parameters my $authority = ''; my $value = 10; my $participantsFile = 'santaList.txt'; # Name#email\n my $previousFile = 'lastYear.txt'; # sorted md5 hashes\n my $serverInfoFile = 'emailCredentials.dat'; # Declare variables with file-wide scope my (%emails, @names, %matching, @previous, @content); # Initialize data open INPUT, '<' . $participantsFile; while (<INPUT>) { chomp; my ($name,$email) = split '#'; $emails{$name} = $email; } close INPUT; open INPUT, '<' . $previousFile; while (<INPUT>) { chomp; push @previous,$_; } close INPUT; # Generate the list @names = keys(%emails); # Collect the list of all participants GENERATE: while (1) { # Picking loop @matching{@names} = shuffle(@names); # Match 'em up # No one has themselves foreach (@names) { next GENERATE if $_ eq $matching{$_}; } # Generate digests for comparison my @digest = (); foreach (@names) { push @digest, md5_hex($_, '=>', $matching{$_}); } @digest = sort @digest; # Compare against previous year's results my $index = 0; foreach (@digest) { while ($index < @previous and $_ gt $previous[$index]) {$index +++} last if $index == @previous; next GENERATE if $_ eq $previous[$index]; } #Passes - store the digests for next year open OUTPUT, '>' . $previousFile; print OUTPUT join "\n", @digest; close OUTPUT; last GENERATE; # Passes } # E-mail the results { open INPUT, '<' . $serverInfoFile; my $host = <INPUT>; chomp $host; my $port = <INPUT>; chomp $port; my $user = <INPUT>; chomp $user; my $password = <INPUT>; chomp $password; close INPUT; my $server = Net::SMTP::TLS->new( $host, Port => $port, User => $user, Password=> $password, ) or die "Can't open mail connection: $!"; # Independent auditor if ($authority) { @content = (); $content[0] = "The picks for this year\'s gifting are as follo +ws\:"; foreach (@names) { push @content, "$_ is giving to $matching{$_}"; } send_mail($server, $authority, $user, 'Secret Santa Drawing', +@content); } foreach (@names) { @content = (); $content[0] = "Dear $_\,"; $content[1] = ""; $content[2] = "Thank you for participating in this year\'s Sec +ret"; $content[3] = "Santa gift exchange\. This year\, you will be +giving"; $content[4] = "a gift to $matching{$_}\. Please remember to l +imit the"; $content[5] = "monetary value of any gift you give to \$$value +\."; $content[6] = ""; $content[7] = "Happy Holidays\,"; $content[6] = "Robo-Santa 5000"; send_mail($server, $emails{$_}, $user, 'Secret Santa Drawing', + @content); } $server->quit; } sub send_mail { my($server, $to, $from, $subject, @body) = @_; $server->mail($from); $server->to($to); $server->data(); $server->datasend("To: $to\n"); $server->datasend("From: $from\n"); $server->datasend("Subject: $subject\n"); $server->datasend("\n"); foreach (@body) { $server->datasend("$_\n"); } $server->dataend(); }

Replies are listed 'Best First'.
Re^2: Temporarily Obscuring a Lottery Draw
by ikegami (Patriarch) on Nov 02, 2008 at 22:16 UTC

    May I recommend two improvements?

    • If you're ok with there being only a single chain — I'd even think it was preferable — then

      @matching{@names} = shuffle(@names); # Match 'em up # No one has themselves foreach (@names) { next GENERATE if $_ eq $matching{$_}; }

      simplifies to

      %matching = ( map { $_, $_ } @names )[ 1..@names*2-1, 0 ];
    • Another common limit is that B doesn't give to A if A gave to B the previous year. That can be achieved by changing

      push @digest, md5_hex($_, '=>', $matching{$_});

      to

      push @digest, md5_hex(join '<=>', sort $_, $matching{$_});

    someone actually bothers to try to crack it

    That's *very* easy to do. Say you have "N" participants.

    • To find out from whom someone specific receives requires at most N hashes, half that on average.
    • To find out to whom someone specific gives requires at most N hashes, half that on average.
    • To find all relations requires at most (N*(N-1)-1)/2 hashes, half that on average.

    It's even easier than attacking passwords of length 2. Hashing the pairings is merely security theatre. You might as well MIME::Base64 them.

      B doesn't give to A if A gave to B the previous year

      That's an interesting one - I may implement it

      That's *very* easy to do

      The real security is chmodding the file to 600. However, there are a few people in the admin group (including myself), so the md5 is more about overhead (making someone take time to write a script) than actual security. The only truly secure choice I can see implementing is the e-mail reminder.

        The overhead is very little more than using MIME::Base64. The (untested) "decrypting" script:

        I realise this isn't a place where security is critical. I just wanted to introduce you to security thinking for future reference.

        By the way, change
        open INPUT, '<' . $participantsFile
        to
        open INPUT, '<', $participantsFile
        for free benefits. It wouldn't hurt to add at least the very simple "or die $!;".