view release on metacpan or  search on metacpan

bin/mitdk2pop  view on Meta::CPAN

}

sub debug($)
{
	return unless $opt{debug};
	my $t = scalar localtime;
	warn "$t: $_[0]\n";
}

my $serv = lambda {
	context $server;
	accept {
		# incoming connection
		my $conn = shift;
		again;

		unless ( ref($conn)) {
			debug("accept() error:$conn") if !ref($conn);
			return;
		}
		$conn-> blocking(0);

       		my $hostname = inet_ntoa((sockaddr_in(getsockname($conn)))[1]);

		debug("[$hostname] connect");

		my $buf     = '';
		my $session = { hostname => $hostname };
		my $resp    = ok("POP3 server ready\x{a}");
		context writebuf, $conn, \$resp, length($resp), 0, $conn_timeout;
	tail {
		context readbuf, $conn, \$buf, qr/^([^\r\n]*)[\r\n]+/s, $conn_timeout;
	tail {
		my @frame = get_frame;
		my ( $match, $error) = @_;
		unless ( defined($match)) {
			debug("[$hostname] session error: $error");
			undef @frame; # circular refs!
			return close($conn);
		}
		substr( $buf, 0, length($match)) = '';
		my $resp = handle( $match, $session);
		context ref($resp) ? $resp : lambda {};
	tail {
		$resp = shift if ref $resp;
		$resp .= "\x{a}";
		context writebuf, $conn, \$resp, length($resp), 0, $conn_timeout;
	tail {
		if ($session->{quit}) {
			debug("[$hostname] QUIT");
			undef @frame; # circular refs!
			close($conn);
		} else {
			set_frame(@frame);
			again;
		}
	}}}}}
};

sub fail($) { "-ERR $_[0]" }
sub ok($) { "+OK $_[0]" }
sub multi
{
	my @msgs;
	my $comment = shift;
	for ( @_ ) {
		my $p = $_;
		$p .= ' ' if $p eq '.';
		push @msgs, $p;
	}
	return ok(join("\x{a}", $comment, @msgs, '.'));
}

sub remotefail($)
{
	debug($_[0]);
	fail("mit.dk says: $_[0]");
}

sub want_list
{
	my $session = shift;
	return lambda {
		return 1 if $session->{list};

		context $session->{obj}->list_all_messages;
	tail {
		my ( $list, $error ) = @_;
		unless ( $list ) {
			$session->{error} = $error;
			return 0;
		} else {
			$session->{list} = $list;
			return 1;
		}
	}};
}

sub pop3_capa
{
	multi("my caps",
		"USER", "UIDL", "TOP",
		"EXPIRE $conn_timeout", "IMPLEMENTATION Shlemazle-Plotz-v$Net::MitDK::VERSION/$version"
	)
}

sub pop3_user
{
	my ($session, $user) = @_;
	return fail("already authorized") if exists $session->{obj};

	my ( $obj, $error) = Net::MitDK->new(
		profile => $user, 
		( defined $opt{config} ) ? ( homepath => $opt{config} ) : (),
	);
	return fail($error) if defined $error;
	$obj->mgr->readonly(1); # the daemon runs as nobody

	$session->{obj} = $obj;
	return ok("hello");
}