view release on metacpan or  search on metacpan

lib/CGI/ContactForm.pm  view on Meta::CPAN

        }
        # Ensure line is fixed, since we joined all flowed lines
        $line = _trim($line);

        # Increment quote depth if we're quoting
        $num_quotes++ if $args->{quote};

        if ( !( defined $line and length $line ) ) {
            # Line is empty
            push @output, '>' x $num_quotes;
        } elsif (length($line) + $num_quotes <= $args->{max_length} - 1) {
            # Line does not require rewrapping
            push @output, '>' x $num_quotes . _stuff($line, $num_quotes);
        } else {
            # Rewrap this paragraph
            while ( defined $line and length $line ) {
                # Stuff and re-quote the line
                $line = '>' x $num_quotes . _stuff($line, $num_quotes);

                # Set variables used in regexps
                my $min = $num_quotes + 1;
                my $opt1 = $args->{opt_length} - 1;
                my $max1 = $args->{max_length} - 1;
                if ( length($line) <= $args->{opt_length} ) {
                    # Remaining section of line is short enough
                    push @output, $line;
                    last;
                } elsif ( $line =~ /^(.{$min,$opt1}) (.*)/ ||
                  $line =~ /^(.{$min,$max1}) (.*)/ || $line =~ /^(.{$min,}) (.*)/ ) {
                    # 1. Try to find a string as long as opt_length.
                    # 2. Try to find a string as long as max_length.
                    # 3. Take the first word.
                    push @output, "$1 ";
                    $line = $2;
                } else {
                    # One excessively long word left on line
                    push @output, $line;
                    last;
                }
            }
        }
    }

    join("\n", @output)."\n";
}

sub checktimestamp {
    my ($tempdir, $time) = @_;
    $tempdir ||= $CGITempFile::TMPDIRECTORY;
    my $cookie;
    unless ( $ENV{HTTP_COOKIE} and ($cookie) = $ENV{HTTP_COOKIE} =~ /\bContactForm_time=(\d+)/ ) {
        CFdie("Your browser is set to refuse cookies.<br>\n"
          . "Change that setting to accept at least session cookies, and try again.\n");
    }
    open FH, File::Spec->catfile( $tempdir, 'ContactForm_time' )
      or die "Couldn't open timestamp file: $!";
    chomp( my @timestamps = <FH> );
    close FH or die $!;
    if ( $cookie + 7200 < $time or ! grep $cookie eq $_, @timestamps ) {
        settimestamp($tempdir, $time);
        CFdie("Timeout due to more than an hour of inactivity.\n"
          . '<p><a href="javascript:history.back(1)">Go back one page</a> and try again.');
    }
}

sub settimestamp {
    my ($tempdir, $time) = @_;
    $tempdir ||= $CGITempFile::TMPDIRECTORY;

    sysopen FH, File::Spec->catfile( $tempdir, 'ContactForm_time' ), O_RDWR|O_CREAT
      or die "Couldn't open timestamp file: $!";
    flock FH, LOCK_EX or die $!;
    chomp( my @timestamps = <FH> );
    sysseek FH, 0, 0 or die $!;
    if ( @timestamps == 2 && $time > $timestamps[0] + 3600 or @timestamps == 1 ) {
        truncate FH, 0 or die $!;
        print FH join( "\n", $time, $timestamps[0] ), "\n";
        print "Set-cookie: ContactForm_time=$time\n";
    } elsif ( @timestamps == 0 ) {
        truncate FH, 0 or die $!;
        print FH "$time\n";
        print "Set-cookie: ContactForm_time=$time\n";
    } else {
        print "Set-cookie: ContactForm_time=$timestamps[0]\n";
    }
    close FH or die $!;
}

sub checkspamfilter {
    my ($msg, $filter) = @_;
    if ( $filter and $msg =~ /$filter/ ) {
        CFdie("The message was trapped in a spam filter and not sent.\n"
          . "You may want to try again with a modified message body.\n"
          . '<p><a href="javascript:history.back(1)">Back</a>');
    }
}

sub checkmaxperhour {
    my ($args, $time, $host) = @_;
    my $tempdir = $args->{tempdir} || $CGITempFile::TMPDIRECTORY;
    my (@senders, %senders);

    sysopen FH, File::Spec->catfile( $tempdir, 'ContactForm_sent' ), O_RDWR|O_CREAT
      or die "Couldn't open request file: $!";
    flock FH, LOCK_EX or die $!;
    while ( <FH> ) {
        my ($timestamp, $ip) = /^(\d+)\t(.+)/;
        next if $timestamp < $time - 3600;
        push @senders, $_;
        $senders{$ip}++;
    }
    push @senders, "$time\t$host\n";
    $senders{$host}++;
    seek FH, 0, 0 or die $!;
    truncate FH, 0 or die $!;
    print FH @senders;
    close FH or die $!;

    if ( $senders{$host} > $args->{maxperhour} ) {
        CFdie('Too many send attempts from the same host. You may want to try later.');
    }