view release on metacpan or  search on metacpan

lib/Mail/POP3/Server.pm  view on Meta::CPAN

        }
    }
    $self->force_shutdown("+OK TTFN $self->{CLIENT_USERNAME}...");
}

=head2 bad_user

Handles bad user.

=cut

# Reject bogus login name and exit or fake a password auth
sub bad_user {
    my $self = shift;
    $self->log_entry("$self->{CLIENT_IP}\tBOGUS user name given at") if $self->{CONFIG}->{debug} == 1;
    if ($self->{CONFIG}->{reject_bogus_user} == 1) {
        print "-ERR no record here of $self->{CLIENT_USERNAME},...$CRLF";
        $self->shutdown;
    } else {
        my $request;
        print "+OK $self->{CLIENT_USERNAME} send me your password....$CRLF";
        alarm 10;
        sysread $self->{INPUT_FH}, $request, 1;
        alarm 0;
        print "-ERR access denied$CRLF";
        $self->shutdown;
    }
}

=head2 peer_lookup

Reverse lookup.

=cut

# do a reverse lookup
sub peer_lookup {
    my ($self, $ip) = @_;
    lc gethostbyaddr(inet_aton($ip), IO::Socket::AF_INET);
}

=head2 log_user_open

Optional per-user brief logging of connection times

=cut

sub log_user_open {
    my ($self, $user_name) = @_;
    return unless defined $self->{CONFIG}->{user_log}->{$user_name};
    if (!-d $self->{CONFIG}->{user_log_dir}) {
        mkdir $self->{CONFIG}->{user_log_dir};
        chmod 01777, $self->{CONFIG}->{user_log_dir};
    }
    my $logfile = "$self->{CONFIG}->{user_log_dir}/${user_name}_log";
    $self->{USERLOG_FH} = IO::File->new(
        ">>$logfile"
    );
    eval {
        # in case we're on Windoze...
        chown((getpwnam $self->{CLIENT_USERNAME})[2], $logfile);
        chmod 0600, $logfile;
    };
    $self->log_user_entry("CONNECTION OPENED");
}

=head2 log_user_close

=cut

sub log_user_close {
    my ($self) = @_;
    return unless
        $self->{USERLOG_FH} and
        defined $self->{CONFIG}->{user_log}->{$self->{CLIENT_USERNAME}};
    close $self->{USERLOG_FH};
}

=head2 log_user_entry

Record mpopd conversations in the individual mailbox log.

=cut

sub log_user_entry {
    my ($self, $response) = @_;
    return unless
        $self->{USERLOG_FH} and
        $self->{CONFIG}->{user_log}->{$self->{CLIENT_USERNAME}} and
        $self->{CONFIG}->{user_log}->{$self->{CLIENT_USERNAME}} == 2;
    if ($response =~ /^PASS\s+(.*)/ and $self->{CONFIG}->{passsecret}) {
        $response =~ s/$1/******/;
    }
    $self->{USERLOG_FH}->print(localtime() . " $response\n");
}

=head2 send_to_user

Takes C<$text>, C<$log_suppress>.

CRLF is added here, and also logged if C<$log_suppress> is false

=cut

sub send_to_user {
    my ($self, $text, $log_suppress) = @_;
    print "$text$CRLF";
    $self->log_user_entry($text) unless $log_suppress;
}

=head2 force_shutdown

# Close the mailbox in a sane state and close the connection

=cut

sub force_shutdown {
    my ($self, $signoff) = @_;
    if ($signoff) {
        if ($signoff eq "ALRM") {
            $signoff = "Haven't got all day you know...";
        } elsif ($signoff eq "USR1") {
            $signoff = "My parent told me to close...";
        }
        $self->send_to_user(
            $signoff
        );
    } else {
        $self->send_to_user(
            "Sorry your time is up :)"
        );
    }
    $self->log_user_close;
    if ($self->{MAILBOX_OPENED}) {
        $self->{MAILBOX}->lock_release;
    }
    $self->shutdown;
}

=head2 log_entry

Write something in the main mpopd log

=cut

sub log_entry {
    my ($self, $error) = @_;
    return unless defined $self->{CONFIG}->{debug_log};
    $> = 0;
    unless ($self->{DEBUG_FH}) {
        my ($debuglog_dir) = $self->{CONFIG}->{debug_log} =~ /^(.+)\//;
        if (!-d $debuglog_dir) {
            mkdir $debuglog_dir, 0700;
        }
        $self->{DEBUG_FH} = IO::File->new(">>$self->{CONFIG}->{debug_log}")
            or die "open >>$self->{CONFIG}->{debug_log}: $!\n";
        my $gid = $^O =~ /MSWin32/ ? 0 : getgrnam("root");
        chown 0, $gid, $self->{CONFIG}->{debug_log};
        chmod 0600, $self->{CONFIG}->{debug_log};
    }
    my $logtime = localtime(time);
    $self->{DEBUG_FH}->print("$error\t$logtime\n");
    $> = $self->{CLIENT_USER_ID} if $self->{CLIENT_USER_ID};
}

=head2 shutdown

Clean up and exit

=cut

sub shutdown {
    my $self = shift;
    close $self->{INPUT_FH};
    exit(0);
}

1;