diff options
author | Yorhel <git@yorhel.nl> | 2016-06-21 19:21:35 +0200 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2016-06-21 19:21:35 +0200 |
commit | b894e0442343861fda9084a2be19e915d744e14b (patch) | |
tree | d38c5546f3f30dcb3e8666eb7352dcf9f279626b /index.cgi | |
parent | 1d23ed0d3894963def629fec61c282a330248b7a (diff) |
Remove 'long url' option and use secure-but-not-that-long URLs
i.e. don't put the burden of security on the user, but instead provide a
secure-by-default experience. The downside is that the convenient
ultra-short URLs are now gone, but these new secure URLs aren't all that
bad either.
Diffstat (limited to 'index.cgi')
-rwxr-xr-x | index.cgi | 66 |
1 files changed, 29 insertions, 37 deletions
@@ -24,7 +24,8 @@ TUWF::set( pre_request_handler => \&init, ); -my $codematch = qr/([a-z0-9]{5}|[a-zA-Z0-9\.-]{32})/; +# The first two matches are legacy paste codes, will not be generated anymore. +my $codematch = qr/([a-z0-9]{5}|[a-zA-Z0-9\.-]{32}|[a-zA-Z0-9]{12})/; TUWF::register( qr// => \&home, qr/mypastes/ => \&mypastes, @@ -75,12 +76,10 @@ sub upload { { post => 's', required => 0, default => 'nosyntax', enum => \@syntax }, { post => 'w', required => 0, default => 0 }, { post => 'c', required => 0, default => 0 }, - { post => 'l', required => 0, default => 0 }, ); return $self->msg('Unknown syntax code', 'backform') if $f->{_err} && grep $_->[0] eq 's', @{$f->{_err}}; - my $code = $self->getcode(!!$f->{l}); - return if !$code; + my $code = $self->getcode(); # create redirect response first, so that any Set-Cookie headers set in # ->passcode() aren't forgotten. msg() calls resInit() anyway @@ -273,7 +272,9 @@ sub _get_html { package TUWF::Object; use TUWF ':html', 'html_escape'; +use POSIX 'floor'; use Socket 'inet_pton', 'inet_ntop', 'AF_INET', 'AF_INET6'; +use feature 'state'; sub htmlHeader { @@ -349,9 +350,6 @@ sub htmlUploadForm { input type => 'checkbox', class => 'check', id => 'c', name => 'c', value => 1, $r->{parse_urls} ? (checked => 'checked') : (); label for => 'c', ' make URLs clickable'; br; - input type => 'checkbox', class => 'check', id => 'l', name => 'l', value => 1; - label for => 'l', ' secure but ugly URL'; - br; i 'Syntax highlighting: '; input type => 'text', name => 's', id => 's', size => 10, value => $r->{syntax}; i; @@ -509,39 +507,33 @@ sub passcode { } -sub getcode { - my($self, $secure) = @_; - # The secure character set must be a power-of-two number of chars, otherwise - # we'd introduce a bias in the random string generator below. 32 characters - # in base64 correspond to 192 bits, which is quite secure. - my @chars = $secure ? ('0'..'9', 'a'..'z', 'A'..'Z', '-', '.') : ('0'..'9', 'a'..'z'); - my $numchars = $secure ? 32 : 5; - - open my $R, '<', '/dev/urandom' or die "Unable to open /dev/urandom\n"; - - my($i, $code) = (0); - while($i < 10) { - # Use one byte of random for each character. We're throwing away some - # random data this way (256 possibilities when we only have 36 or 64), but - # that's alright. - my $r = sysread($R, $code, $numchars); - die "Did not read enough random numbers (got $r, $!)\n" if $r != $numchars; - $code = join '', map $chars[$_ % @chars], unpack 'C*', $code; - - # Weird characters at the start or end are annoying, skip these - next if $code =~ /^[-.]/ || $code =~ /[-.]$/; - - last if !$self->dbRow('SELECT 1 AS exist FROM pastes WHERE code = ?', $code)->{exist}; - warn "Generated duplicate code: $code. Trying again...\n"; - $i++; +# Get a secure and uniform random number between 0 and $n (0 inclusive, $n exclusive, $n <= 256) +sub getrand { + my $n = shift; + state $R; + if(!$R) { + open $R, '<', '/dev/urandom' or die "Unable to open /dev/urandom\n"; } - - if($i == 10) { - warn "!! No unused code found within 10 iterations!\n"; - $self->msg('Unable to allocate new code, please try again later.'); - return undef; + my $i = 20; + while($i-- > 0) { + my $buf; + die "Unable to read from /dev/urandom" if sysread($R, $buf, 1) != 1; + my $c = unpack('C', $buf); + return $c % $n if $c < $n*floor(256/$n); } + die "Unable to fetch random number\n"; +} + +# Paste codes are now 12 characters of [a-zA-Z0-9], which is around 71.5 bits +# in strength. This is already hard (but not entirely infeasable) to +# brute-force at high speeds, but is completely infeasable to guess with the +# throttle of 1 guess per 10 seconds in place. +sub getcode { + my $self = shift; + my @chars = ('0'..'9', 'a'..'z', 'A'..'Z'); + my $code = join '', map $chars[getrand(scalar @chars)], 1..12; + die "Generated duplicate code: $code.\n" if $self->dbRow('SELECT 1 AS exist FROM pastes WHERE code = ?', $code)->{exist}; return $code; } |