# Copyright © 2011 Nick Bowler
#
# License WTFPL2: Do What The Fuck You Want To Public License, version 2.
# This is free software: you are free to do what the fuck you want to.
# There is NO WARRANTY, to the extent permitted by law.
#
# ShortenURL implements an HTTP URL shortener for Irssi.  It consists of two
# parts: an HTTP server to handle the short URLs, and a message filter which
# replaces long URLs with short ones.  Message filtering occurs after logging,
# so the log files should contain original URLs (which is good because the
# shortened URLs cease to be valid once the script is unloaded).
#
# In IRC discussions, people often use URLs as words in a sentence.  For
# instance,
#
#   < luser> Check out my awesome webpage at
#            http://example.org/I_like_very_long_urls_for_no_reason!
#
# If we matched the longest possible valid URIs, we would shorten the full URL
# including the trailing exclamation point.  But in this case, it is possible
# that the exclamation point was not intended to be interpreted as part of the
# URL.  Since ShortenURL can't possibly decide whether or not trailing
# punctuation is part of the sentence structure or the URL, it employs a simple
# rule: any punctuation immediately following a URL is not considered part of
# the URL for shortening.  To handle the situation where the punctuation is
# part of the URL, the HTTP server permits arbitrary punctuation to follow any
# shortened URL.  Any such trailing punctuation will be appended to the long
# URL.
#
# ShortenURL has a number of options:
#
#   shortenurl_url_addr (default: "::1")
#     The address that ShortenURL will use for the short URLs that it
#     generates.  This is useful if you run Irssi on a remote machine.
#
#   shortenurl_bind_addr (default: "")
#     The bind address and/or port of the ShortenURL HTTP server.
#
#   shortenurl_level (default: msgs public)
#     The message levels for which ShortenURL will translate URLs.
#
#   shortenurl_redirect (default: ON)
#     If enabled, HTTP responses will return a 301 Moved Permanently
#     status which will normally cause browsers to load the full URL
#     automatically.  If disabled, you will be presented with an HTML
#     document that links to the full URL instead.  Regardless of this
#     setting, it is possible to visit the redirect page by appending
#     ?safe to the short URL.
#
#   shortenurl_threshold (default: 0)
#     The minimum length (in bytes) that a URL needs to be to be considered
#     for shortening.  No matter what this is set to, ShortenURL will never
#     replace a URL unless the replacement is actually shorter.

use strict;
use feature "state";
use vars qw($VERSION %IRSSI);

use IO::Socket::INET6;
use Socket qw(:crlf);
use Errno qw(:POSIX);
use Encode;

use MIME::Base64 qw(encode_base64url);
use Digest::SHA qw(sha224);
use Regexp::Common qw(URI);
use XML::Generator;
use HTTP::Parser;

$VERSION = '0.8';
%IRSSI = (
	authors     => 'Nick Bowler',
	contact     => 'nbowler@draconx.ca',
	name        => 'ShortenURL',
	description => 'Automatically shortens long URLs.',
	license     => 'WTFPL2',
);

Irssi::settings_add_str  ("shortenurl", "shortenurl_url_addr",  "::1");
Irssi::settings_add_str  ("shortenurl", "shortenurl_bind_addr", "");
Irssi::settings_add_level("shortenurl", "shortenurl_level",     "msgs public");
Irssi::settings_add_bool ("shortenurl", "shortenurl_redirect",  1);
Irssi::settings_add_int  ("shortenurl", "shortenurl_threshold", 0);

my $listenport = 0;
my %urihash;

sub conn_close {
	my ($conn) = @_;

	Irssi::timeout_remove($conn->{timetag});
	Irssi::input_remove($conn->{datatag});
	close $conn->{sock};
}

sub xhtml_generator {
	my $xhtml_w3c = '"-//W3C//DTD XHTML 1.1//EN"';
	my $xhtml_dtd = '"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"';

	return XML::Generator->new(
		pretty      => 2,
		conformance => 'strict',
		encoding    => 'utf-8',
		namespace   => ["http://www.w3.org/1999/xhtml"],
		dtd         => ["html", "PUBLIC", $xhtml_w3c, $xhtml_dtd],
	);
}

sub error_page {
	my ($resp) = @_;

	my $g = xhtml_generator;
	my $doc = $g->html(
		$g->head($g->title($resp->status_line)),
		$g->body(
			$g->h1($resp->status_line)
		)
	);

	return $g->xmldecl . "$doc\n";
}

sub error_response {
	my ($resp, $code, $method) = @_;

	$resp->code($code);
	$resp->content(Encode::encode_utf8(error_page($resp)));
	$resp->header("Content-Type" => "application/xhtml+xml; charset=utf-8");
	$resp->header("Content-Length" => length $resp->content);

	if (defined $method && $method eq "HEAD") {
		$resp->content(undef);
	}

	return $resp->as_string($CRLF);
}

sub redir_page {
	my ($loc) = @_;

	my $g = xhtml_generator;
	my $doc = $g->html(
		$g->head($g->title("ShortenURL Redirector")),
		$g->body(
			$g->h1("ShortenURL Redirector"),
			$g->p($g->a({href=>$loc}, $loc))
		)
	);

	return $g->xmldecl . "$doc\n";
}

sub redir_response {
	my ($resp, $loc, $method) = @_;

	$resp->content(Encode::encode_utf8(redir_page($loc)));
	$resp->header("Content-Type" => "application/xhtml+xml; charset=utf-8");
	$resp->header("Content-Length" => length $resp->content);

	if ($method eq "HEAD") {
		$resp->content(undef);
	}

	return $resp->as_string($CRLF);
}

sub conn_process {
	my ($conn) = @_;
	my ($digest, $base, $tail);
	my $do_redirect = Irssi::settings_get_bool("shortenurl_redirect");

	my $resp = HTTP::Response->new(200);
	my $req = $conn->{parser}->object;

	$resp->header(Server => "ShortenURL/$VERSION");

	# Respond using the same protocol as the request.
	# (The X-Http-Version header is added by HTTP::Parser)
	$resp->protocol("HTTP/" . $req->header("X-Http-Version"));

	# Check the request type
	unless ($req->method eq "GET" || $req->method eq "HEAD") {
		$conn->{output} = error_response($resp, 501);
		return;
	}

	# Check the URI format
	unless ($req->uri->path =~ m/^\/([-_[:alnum:]]+)([?!;,.]*)$/) {
		$conn->{output} = error_response($resp, 404, $req->method);
		return;
	}

	($digest, $tail) = ($1, $2);
	unless (defined $urihash{$digest}) {
		$conn->{output} = error_response($resp, 404, $req->method);
		return;
	}

	if ($req->uri->query =~ m/safe/i) {
		$do_redirect = 0;
	}

	$base = $urihash{$digest};
	if ($do_redirect) {
		$resp->code(301);
		$resp->header("Location" => "$base$tail");
	}
	$conn->{output} = redir_response($resp, "$base$tail", $req->method);
}

sub conn_write {
	my ($conn) = @_;
	my $rc;

	unless (length $conn->{output} > 0) {
		conn_close($conn);
		return;
	}

	$rc = $conn->{sock}->send($conn->{output}, 0);
	if (!defined $rc) {
		print CLIENTERROR "shortenurl write failure: $!";
		conn_close($conn);
		return;
	}

	$conn->{output} = substr($conn->{output}, $rc);
}

sub conn_read {
	my ($conn) = @_;
	my $buf;

	unless (defined $conn->{sock}->recv($buf, 1024, MSG_DONTWAIT)) {
		unless ($!{EWOULDBLOCK}) {
			print CLIENTERROR "shortenurl read failure: $!";
			conn_close($conn);
		}

		return;
	}

	unless (length $buf > 0) {
		# Remote closed the connection, clean up.
		conn_close($conn);
		return;
	}

	unless (defined $conn->{parser}) {
		$conn->{parser} = HTTP::Parser->new( request => 1 );
	}

	# HTTP::Parser likes to die gratuitously, so trap that.
	eval {
		$_ = $conn->{parser}->add($buf);

		# Since we don't support any requests with content,
		# we can treat the 0 and -3 returns identically.
		return unless ($_ == 0 || $_ == -3);

		conn_process($conn);
		Irssi::input_remove($conn->{datatag});
		$conn->{datatag} = Irssi::input_add(fileno($conn->{sock}),
		                          INPUT_WRITE, "conn_write", $conn);
	} or do {
		conn_close($conn);
	}
}

sub server_new_conn {
	my ($listensock) = @_;
	my %conn;

	$conn{sock}    = $listensock->accept();
	$conn{timetag} = Irssi::timeout_add_once(5000, "conn_close", \%conn);
	$conn{datatag} = Irssi::input_add(fileno($conn{sock}), INPUT_READ,
	                                  "conn_read", \%conn);
}

sub server_start {
	my $sock = new IO::Socket::INET6(
		Proto     => 'tcp',
		Listen    => 10,
		LocalAddr => Irssi::settings_get_str("shortenurl_bind_addr"),
	) or die "Failed to create listen socket: $!.";

	$listenport = $sock->sockport();
	print CLIENTNOTICE "ShortenURL listening on port $listenport";
	Irssi::input_add(fileno($sock), INPUT_READ, "server_new_conn", $sock);
}
server_start();

sub process_uri {
	my ($uri) = @_;
	my ($base, $tail, $digest, $newuri);
	my $threshold = Irssi::settings_get_int("shortenurl_threshold");
	my $host = Irssi::settings_get_str("shortenurl_url_addr");

	return $uri unless (length $uri > $threshold);

	$uri =~ m/^(.*?)([?;!,.]*)$/;
	($base, $tail) = ($1, $2);
	$digest = substr(encode_base64url(sha224($base)), 0, 12);

	$host = "[$host]" if ($host =~ /:/);
	$newuri = "http://$host:$listenport/$digest$tail";
	return $uri if (length $newuri >= length $uri);

	$urihash{$digest} = $base;
	return $newuri;
}

sub filter_text {
	my ($dest, $text, $stripped) = @_;
	state $handling = 0;

	# Avoid accidentally throwing Irssi into an infinite loop.
	return if ($handling);
	$handling = 1;

	if (Irssi::settings_get_level("shortenurl_level") & $dest->{level}) {
		$text =~ s/($RE{URI}{HTTP})/process_uri($1)/ge;
		Irssi::signal_continue($dest, $text, $stripped);
	}

	$handling = 0;
}
Irssi::signal_add("print text", "filter_text");
