getpaste

#!/usr/bin/env perl
# getpaste - retrieves raw text from pastebins
#
# (c) 2010-2021 Mantas Mikulėnas <grawity@gmail.com>
# Released under the MIT License (dist/LICENSE.mit)
use v5.10;
use warnings;
use strict;
no locale;
use open qw(:std :utf8);
require Crypt::AuthEnc::CCM;
require Crypt::AuthEnc::GCM;
require Crypt::AuthEnc::OCB;
require Crypt::Cipher;
require Crypt::Cipher::AES;
require Crypt::Digest;
require Crypt::Digest::RIPEMD160;
require Crypt::Digest::SHA1;
require Crypt::Digest::SHA512;
require Crypt::KeyDerivation;
require Crypt::Mac::HMAC;
require Crypt::Mac::PMAC;
require Crypt::Mode::CBC;
require Crypt::Mode::OFB;
use Encode qw(decode encode);
use Getopt::Long qw(:config bundling no_ignore_case);
use HTML::Entities;
use JSON;
use LWP::UserAgent;
use MIME::Base64;

my $opt_insecure = 0;
my $opt_show_url = 0;
my $opt_batch = 0;

# generic utility functions {{{

BEGIN {
	if (eval {require Nullroute::Lib}) {
		Nullroute::Lib->import(qw(_trace _debug _warn _err _die));
	} else {
		$::arg0 = (split m!/!, $0)[-1];
		$::debug = !!$ENV{DEBUG};
		$::warnings = 0;
		$::errors = 0;
		sub _trace { warn "trace: @_\n" if $::debug; }
		sub _debug { warn "debug: @_\n" if $::debug; }
		sub _warn  { warn "warning: @_\n"; ++$::warnings; }
		sub _err   { warn "error: @_\n"; ! ++$::errors; }
		sub _die   { _err(@_); exit 1; }
	}
}

sub chunk {
	my ($buf, $bs) = @_;

	return unpack("(A$bs)*", $buf);
}

sub _dump {
	use Data::Dumper;
	return Data::Dumper->new(\@_)->Terse(1)->Indent(0)->Dump;
}

sub _db64 {
	my ($buf) = @_;
	return "[len ".length($buf)."] {".encode_base64($buf, "")."}";
}

sub _dhex {
	my ($buf) = @_;
	return "[len ".length($buf)."] <".encode_hex($buf).">";
}

sub _prompt {
	my ($msg) = @_;

	print STDERR "\e[1m$msg\e[m "; $|++;
	chomp(my $resp = <STDIN>);
	return $resp;
}

# }}}
# URL parsing functions {{{

my $URL_RE = qr{
		(?:    (?<scheme> [^:\/?\#]+) : )?
		(?: // (?<host> [^/?#]*)        )?
		       (?<path> [^?#]*)
		(?: \? (?<query> [^#]*)         )?
		(?: \# (?<fragment> .*)         )?
	}x;

sub parse_url {
	my ($url) = @_;

	if ($url =~ $URL_RE) { return my %url = %+; }
}

sub unparse_url {
	my (%url) = @_;

	my $url = $url{scheme}."://".$url{host};
	$url .= $url{path}         if defined($url{path});
	$url .= "?".$url{query}    if defined($url{query});
	$url .= "#".$url{fragment} if defined($url{fragment});
	return $url;
}

# }}}
# translation database functions {{{

sub smart_match {
	my ($str, $pattern) = @_;

	if (!defined $str) {
		return;
	}
	elsif (ref($pattern) eq "ARRAY") {
		for (@$pattern) {
			my @res = smart_match($str, $_);
			return @res if @res;
		}
	}
	elsif (ref($pattern) eq "Regexp" && $str =~ $pattern) {
		# If $pattern has no capture groups, =~ will return an
		# (1,) in list context since it needs a trueish value.
		# This bit of linenoise works consistently in all cases.
		return map {substr($str, $-[$_], $+[$_]-$-[$_])} 0..$#-;
		#return @{^CAPTURE}; # new in 5.26
	}
	elsif (ref($pattern) eq "" && $str eq $pattern) {
		return $str;
	}
	return;
}

my $EXPN_RE = qr/#(#|\d|\{\w+.\d+\})/;

sub expn {
	my ($str, $data, $def) = @_;

	for ($str) {
		if ($_ eq "#") {
			return $_;
		} elsif ($def && /^(\d+)$/) {
			return $data->{$def}->[$1] // "";
		} elsif (/^\{(\w+).(\d+)\}$/) {
			return $data->{$1}->[$2] // "";
		} else {
			_err("unknown expansion '#$_'");
			return "\x{1F612}";
		}
	}
};

my @SITES;

sub translate_url {
	my ($url) = @_;

	my @fields = qw(scheme host path query fragment);

	my %url = parse_url($url);

	unless (%url && defined($url{host}) && defined($url{path})) {
		_die("bad URL: $url");
	}

	_debug("scheme='".($url{scheme}//"")."'".
		", host='".($url{host}//"")."'".
		", path='".($url{path}//"")."'".
		", query='".($url{query}//"")."'".
		", frag='".($url{fragment}//"")."'");

SITE:	for my $site (@SITES) {
		use Data::Dumper;

		my %match;
		for (@fields) {
			my $pat = $site->{"$_"} or next;
			my @res = smart_match($url{$_}, $pat) or next SITE;
			_debug("match $_ ~ "._dump($pat));
			_debug(" -> "._dump(\@res));
			$match{$_} = \@res;
		}
		next if !%match;

		if ($site->{"note"}) { _debug($site->{"note"}); }

		for (@fields) {
			$match{$_} //= [$url{$_}];
		}

		for (@fields) {
			my $fmt = $site->{"to_$_"} // next;
			$fmt =~ s/$EXPN_RE/expn($1, \%match, $_)/ge;
			$url{$_} = $fmt;
		}

		my $raw_url = unparse_url(%url);
		my $func = $site->{"parser"};
		if ($func) {
			return ($raw_url, $func, $url{fragment});
		} else {
			return ($raw_url);
		}
	}
	return;
}

sub retrieve_paste {
	my ($url) = @_;

	my ($raw_url, $handler, @hargs) = translate_url($url);

	if ($opt_batch) {
		if ($handler) {
			print "$url [internal]\n";
		} elsif ($raw_url) {
			print "$url $raw_url\n";
		} else {
			print "$url [unknown]\n";
		}
	} elsif (!$raw_url && !$handler) {
		_err("unknown pastebin: $url");
	} elsif ($opt_show_url) {
		if ($handler) {
			_err("pastebin does not have raw URLs: $url");
		} else {
			print "$raw_url\n";
		}
	} else {
		if ($handler) {
			my $output = $handler->($raw_url, @hargs);
			if (defined $output) {
				utf8::decode($output);
				print "$output\n";
			} else {
				_err("paste extraction failed");
			}
		} else {
			getprint($raw_url);
		}
	}
}

sub dl_recursive {
	my ($url) = @_;

	my $target = follow($url);

	return retrieve_paste($target);
}

# }}}
# HTTP client functions {{{

my $UA = LWP::UserAgent->new;

sub get {
	my ($url) = @_;

	_debug("fetching '$url'");
	$UA->default_header("Referer" => $url);
	my $resp = $UA->get($url);

	if ($resp->is_success) {
		_debug("fetch complete: '".$resp->status_line."'");
		return $resp->decoded_content // $resp->content;
	} else {
		_err("fetch failed: '".$resp->status_line."'");
		return;
	}
}

sub getprint {
	my ($url) = @_;

	my $data = get($url);
	if (defined $data) {
		print $data;
	}
}

sub post {
	my ($url, %form) = @_;

	_debug("posting to '$url'");
	$UA->default_header("Referer" => $url);
	my $resp = $UA->post($url, \%form);

	if ($resp->is_success) {
		_debug("post complete: '".$resp->status_line."'");
		return $resp->decoded_content // $resp->content;
	} else {
		_err("post failed: '".$resp->status_line."'");
		return;
	}
}

sub follow {
	my ($url) = @_;

	_debug("following '$url'");
	$UA->default_header("Referer" => $url);
	my $resp = $UA->head($url);

	if ($resp->is_success) {
		_debug("fetch complete: '".$resp->status_line."'");
		_debug(" -> '$_'") for map {$_->request->uri} ($resp->redirects, $resp);
		return $resp->request->uri->as_string;
	} else {
		_err("fetch failed: '".$resp->status_line."'");
		return;
	}
}

# }}}
# decoders {{{

sub decode_base58 {
	my ($str, $alpha) = @_;
	# Source: https://metacpan.org/pod/Encode::Base58

	use bigint;
	use integer;

	my @alpha = split(//, $alpha);
	my $i = 0;
	my %alpha = map { $_ => $i++ } @alpha;

	my $decoded = 0;
	my $multi   = 1;
	my $base    = @alpha;

	while (length $str > 0) {
		my $digit = chop $str;
		$decoded += $multi * $alpha{$digit};
		$multi   *= $base;
	}

	return $decoded->to_bytes;
}

sub decode_privatebin_base58 {
	my ($str) = @_;

	return decode_base58($str, "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz");
}

sub decode_sour_base64 {
	my ($str) = @_;

	$str =~ y!_-!/+!;
	return decode_base64($str);
}

sub decode_cescape {
	my ($str) = @_;

	$str =~ s/\\x([0-9A-Fa-f]{2})/chr hex $1/ge;
	return $str;
}

sub encode_hex {
	my ($buf) = @_;

	return unpack("H*", $buf);
}

sub decode_hex {
	my ($str) = @_;

	return pack("H*", $str);
}

sub decode_html {
	my ($str) = @_;

	$str =~ s/&lt;/</g;
	$str =~ s/&gt;/>/g;
	$str =~ s/&quot;/"/g;
	$str =~ s/&amp;/\&/g;
	return $str;
}

sub try_decode_json {
	my ($data) = @_;

	return ref $data ? $data : decode_json($data);
}

# }}}
# decompressors {{{

sub decompress_zlib {
	eval {
		require Compress::Raw::Zlib;
	} or _die("missing Perl package 'Compress::Raw::Zlib'");

	my ($buf, %opt) = @_;

	my $wbits;
	my $stream;
	my $status;
	my $outbuf;

	if ($opt{is_gzip_or_zlib}) {
		# autodetect RFC 1950 (zlib) or 1952 (gzip)
		$wbits = Compress::Raw::Zlib->WANT_GZIP_OR_ZLIB;
		_trace("using WindowBits = $wbits (WANT_GZIP_OR_ZLIB, detect 1950/1952)");
	}
	elsif ($opt{is_gzip}) {
		# expect RFC 1952 (gzip)
		$wbits = Compress::Raw::Zlib->WANT_GZIP;
		_trace("using WindowBits = $wbits (WANT_GZIP, expect 1952)");
	}
	elsif ($opt{is_deflate}) {
		# expect RFC 1951 (deflate)
		$wbits = -Compress::Raw::Zlib->MAX_WBITS;
		_trace("using WindowBits = $wbits (-MAX_WBITS, expect 1951 deflate)");
	}
	elsif ($opt{is_zlib}) {
		# expect RFC 1950 (zlib)
		$wbits = 15;
		_trace("using WindowBits = $wbits (expect 1950 zlib)");
	}
	else {
		# mirror the zlib default
		$wbits = Compress::Raw::Zlib->MAX_WBITS;
		_trace("using WindowBits = $wbits (MAX_WBITS, default)");
	}

	($stream, $status) = Compress::Raw::Zlib::Inflate->new(-WindowBits => $wbits);
	if ($status != Compress::Raw::Zlib->Z_OK) {
		_die("inflateInit failed: $status");
	}

	$status = $stream->inflate($buf, $outbuf);
	if ($status != Compress::Raw::Zlib->Z_OK &&
	    $status != Compress::Raw::Zlib->Z_STREAM_END) {
		_die("inflate failed: $status (".$stream->msg.")");
	}

	return $outbuf;
}

sub decompress_deflate {
	my ($buf) = @_;

	return decompress_zlib($buf, is_deflate => 1);
}

sub decompress_gzip {
	my ($buf) = @_;

	return decompress_zlib($buf, is_gzip => 1);
}

sub decompress_lzw {
	eval {
		require Compress::LZW;
	} or _die("missing Perl package 'Compress::LZW'");

	my ($buf) = @_;

	return Compress::LZW->decompress($buf);
}

sub decompress_inflate {
	my ($buf) = @_;

	require IO::Uncompress::Inflate;
	my $outbuf;
	my $stream = IO::Uncompress::Inflate->new(\$buf);
	my $status = $stream->read($outbuf);
	if ($status <= 0) {
		_die("inflate failed: $IO::Uncompress::Inflate::InflateError");
	}
	return $outbuf;
}

sub decompress_rawinflate {
	my ($buf) = @_;

	require IO::Uncompress::RawInflate;
	my $outbuf;
	my $stream = IO::Uncompress::RawInflate->new(\$buf);
	my $status = $stream->read($outbuf);
	if ($status <= 0) {
		_die("inflate failed: $IO::Uncompress::RawInflate::RawInflateError");
	}
	return $outbuf;
}

# }}}
# extra KDFs {{{

sub EVP_BytesToKey {
	# Key+IV derivation used by 'openssl enc'
	Crypt::Digest->import("digest_data");

	my ($salt, $passphrase, $algo, $len) = @_;

	my $hash = "";
	my $buf = "";
	while (length($buf) < $len) {
		$hash = digest_data($algo, $hash, $passphrase, $salt);
		$buf .= $hash;
	}
	return $buf;
}

# }}}
# extra ciphers {{{

sub ocb2_times2 {
	my ($block) = @_;

	my @block = unpack("C*", $block);
	my $carry = ($block[0] >> 7) & 0x1;
	for (my $i = 0; $i < $#block; $i++) {
		$block[$i] = ($block[$i] << 1) | (($block[$i+1] >> 7) & 0x1);
	}
	$block[$#block] = ($block[$#block] << 1) ^ ($carry * 135);
	return pack("C*", map {$_ & 0xFF} @block);
}

sub ocb2_decrypt_verify {
	Crypt::Mac::PMAC->import("pmac");

	my ($cipher, $key, $nonce, $aad, $ciphertext, $tag) = @_;

	my $c = Crypt::Cipher->new($cipher, $key);
	my $bs = $c->blocksize;
	my $ts = 64 / 8;

	my @ciphertext = chunk($ciphertext, $bs);
	my $final      = pop(@ciphertext);
	my $nfinal     = length($final);
	my $pad        = pack("N*", 0, 0, 0, $nfinal * 8);
	my $delta      = ocb2_times2($c->encrypt($nonce));
	my $checksum   = "\x00" x $bs;
	my $output     = "";

	for my $block (@ciphertext) {
		$block = $c->decrypt($block ^ $delta) ^ $delta;
		$delta = ocb2_times2($delta);
		$output .= $block;
		$checksum ^= $block;
	}

	$final = $final ^ $c->encrypt($delta ^ $pad);
	$output .= substr($final, 0, $nfinal);
	$checksum ^= $final;

	$checksum = $c->encrypt($checksum ^ $delta ^ ocb2_times2($delta));
	$checksum ^= pmac($cipher, $key, $aad) if length($aad);
	$checksum = substr($checksum, 0, $ts);

	return if $checksum ne $tag;
	return $output;
}

# }}}
# unwrappers {{{
#
# These functions parse an encrypted/wrapped package (obtaining cipher, salt,
# iterations, IV...) and return decrypted/unwrapped data.

sub unwrap_defuse {
	Crypt::AuthEnc::OCB->import(":all");
	Crypt::KeyDerivation->import("pbkdf2");

	# serialization: custom [iter + salt + iv + data]
	# key derivation: PBKDF2-SHA256
	# encryption: AES128-OCB2

	my ($data, $passwd) = @_;

	my @data = split(/:/, $data);
	return if @data != 4;

	my $iter = int($data[0]);
	my $salt = decode_hex($data[1]);
	my $iv   = decode_hex($data[2]);
	my $ct   = decode_hex($data[3]);
	my $ks   = 128 / 8;
	my $ts   = 64 / 8;

	my $key  = pbkdf2($passwd, $salt, $iter, "SHA256", $ks);
	my $tag  = substr($ct, -$ts, $ts, "");

	return ocb2_decrypt_verify("AES", $key, $iv, "", $ct, $tag)
	       // _die("decryption failed");
}

sub unwrap_ezcrypt {
	Crypt::KeyDerivation->import("pbkdf2");

	# serialization: raw [salt + data]
	# key derivation: PBKDF2-SHA1
	# encryption: AES-256-OFB

	my ($data, $passwd) = @_;

	my $ks   = Crypt::Cipher::AES->keysize;
	my $bs   = Crypt::Cipher::AES->blocksize;

	my $salt = substr($data, 0, $bs, "");
	my $iter = 1; # LOL
	my $key  = pbkdf2($passwd, $salt, $iter, "SHA1", $ks);
	my $iv   = $salt;

	return Crypt::Mode::OFB->new("AES")->decrypt($data, $key, $iv);
}

sub unwrap_ncrypt {
	my ($data, $passwd, $cipher) = @_;

	# serialization: JSON {data: raw [salt + data], cipher}
	# key derivation: PBKDF2-SHA1
	# encryption: AES-256-OFB (usually?)

	if ($cipher eq "AES-256-OFB") {
		return unwrap_ezcrypt($data, $passwd);
	} else {
		_die("unknown cipher '$cipher' for this pastebin");
	}
}

sub unwrap_openssl_aes {
	# serialization: raw [magic + salt + data]
	# key derivation: EVP_BytesToKey (usually MD5)
	# encryption: AES-256-CBC

	Crypt::KeyDerivation->import("pbkdf2");

	my ($data, $passwd, %opt) = @_;

	my $ks    = Crypt::Cipher::AES->keysize;
	my $bs    = Crypt::Cipher::AES->blocksize;

	my $magic = substr($data, 0, 8, "");
	my $salt  = substr($data, 0, 8, "");

	if ($magic ne "Salted__") {
		_die("bad magic value in encrypted data");
	}

	_debug("pass: ".$passwd);
	_debug("salt: "._db64($salt));
	_debug("salt: "._dhex($salt));

	my $buf;
	if ($opt{pbkdf2}) {
		my $algo = uc($opt{kdf_algo} // "SHA256");
		my $iter = $opt{kdf_iter} // 1000;
		_debug("KDF: PBKDF2 (algo=$algo, iter=$iter)");
		$buf = pbkdf2($passwd, $salt, $iter, $algo, $ks + $bs);
	} else {
		my $algo = uc($opt{kdf_algo} // "MD5");
		_debug("KDF: EVP_BytesToKey (algo=$algo");
		$buf = EVP_BytesToKey($salt, $passwd, $algo, $ks + $bs);
	}

	my $key = substr($buf, 0, $ks, "");
	my $iv = substr($buf, 0, $bs, "");

	_debug("Key: "._db64($key));
	_debug("IV: "._db64($iv));
	_debug("Key: "._dhex($key));
	_debug("IV: "._dhex($iv));

	return Crypt::Mode::CBC->new("AES")->decrypt($data, $key, $iv);
}

sub unwrap_pastesh {
	Crypt::Mac::HMAC->import("hmac");

	my ($vers, $data, $passwd, $atag) = @_;

	_debug("password: $passwd");

	if ($atag) {
		_debug("atag: "._db64($atag));
		my $mac1 = hmac("SHA512", "auth key", $passwd);
		my $mac2 = hmac("SHA512", $mac1, $data);
		if ($mac2 ne $atag) {
			_debug("mac1: "._db64($mac1));
			_debug("mac2: "._db64($mac2));
			_due("bad HMAC");
		}
	}

	if ($vers eq "v3") {
		$data = unwrap_openssl_aes($data, $passwd, (
						pbkdf2 => 1,
						kdf_algo => "SHA512",
						# yes, CryptoJS defaults to 1 in v2/v3
						kdf_iter => 1));
	} else {
		$data = unwrap_openssl_aes($data, $passwd, (kdf_algo => "SHA512"));
	}
	return $data;
}

sub unwrap_privatebin_v2 {
	Crypt::AuthEnc::GCM->import(":all");
	Crypt::KeyDerivation->import("pbkdf2");

	# serialization: JSON
	# key derivation: PBKDF2-SHA256
	# encryption: AES256-GCM

	my ($data, $passwd) = @_;

	if ($data->{v} != 2) {
		_die("incorrect paste format version ".$data->{v});
	}

	my $cparams = $data->{adata}->[0];
	my $ct     = decode_base64($data->{ct});
	my $iv     = decode_base64($cparams->[0]);
	my $salt   = decode_base64($cparams->[1]);
	my $iter   = $cparams->[2];
	my $ks     = $cparams->[3] / 8;
	my $ts     = $cparams->[4] / 8;
	my $cipher = $cparams->[5];
	my $mode   = $cparams->[6];
	my $comp   = $cparams->[7];

	unless ($cipher eq "aes") {
		_die("unsupported cipher ".$cipher);
	}
	unless ($mode eq "gcm") {
		_die("unsupported cipher mode ".$mode);
	}
	unless ($comp =~ /^(none|zlib)$/) {
		_die("unsupported compression ".$comp);
	}

	my $ikey = decode_privatebin_base58($passwd);
	my $dkey = pbkdf2($ikey, $salt, $iter, "SHA256", $ks);

	# note that this relies on the encoder producing the most compact output
	# (or more precisely, behaving like JSON.stringify() in JavaScript)
	my $hdr = encode_json($data->{adata});
	my $tag = substr($ct, -$ts, $ts, "");

	if ($mode eq "gcm") {
		$data = gcm_decrypt_verify("AES", $dkey, $iv, $hdr, $ct, $tag)
		       // _die("decryption failed");
	}
	if ($comp eq "zlib") {
		$data = decompress_deflate($data);
	}
	$data = decode_json($data)->{paste};

	return $data;
}

sub unwrap_sjcl {
	Crypt::AuthEnc::CCM->import(":all");
	Crypt::AuthEnc::GCM->import(":all");
	Crypt::KeyDerivation->import("pbkdf2");

	# serialization: JSON
	# key derivation: PBKDF2-SHA256
	# encryption: AES128-CCM

	my ($json, $passwd) = @_;

	my $data = try_decode_json($json);

	if (($data->{v} //= "1") != 1) {
		_die("unsupported SJCL blob version ".$data->{v});
	}
	if (($data->{cipher} //= "aes") ne "aes") {
		_die("unsupported cipher ".$data->{cipher});
	}

	my $mode = $data->{mode} // "ccm";

	unless ($mode eq "ccm" || $mode eq "gcm") {
		_die("unsupported cipher mode ".$mode);
	}

	my $salt = decode_base64($data->{salt} // "");
	my $ct   = decode_base64($data->{ct});
	my $iv   = decode_base64($data->{iv});
	my $iter = int($data->{iter} || 1000),
	my $ks   = int($data->{ks} || 128) / 8; # key size
	my $ts   = int($data->{ts} || 64) / 8; # tag size
	my $hdr  = decode_base64($data->{adata} // "");

	my $key  = $salt ? pbkdf2($passwd, $salt, $iter, "SHA256", $ks) : $passwd;
	my $tag  = substr($ct, -$ts, $ts, "");

	if ($mode eq "ccm") {
		return ccm_decrypt_verify("AES", $key, $iv, $hdr, $ct, $tag)
		       // _die("decryption failed");
	}
	elsif ($mode eq "gcm") {
		return gcm_decrypt_verify("AES", $key, $iv, $hdr, $ct, $tag)
		       // _die("decryption failed");
	}
}

# }}}
# downloaders {{{
#
# These functions take an URL, extract the wrapped package from it, and call an
# apropriate unwrapper.

sub dl_0bin {
	my ($url, $frag) = @_;

	if (!length $frag) {
		_die("cannot decrypt without key in URL fragment");
	}

	my $body = get($url);
	$body =~ m{<code>\n\s*(\{.+\})\n\s*</code>} || return;

	my $data = decode_html($1);
	$data = unwrap_sjcl($data, $frag);
	$data = decode_base64($data);
	#$data = decompress_lzw($data);
	return $data;
}

sub dl_nothingnet {
	my ($url, $frag) = @_;

	if (!length $frag) {
		_die("cannot decrypt without key in URL fragment");
	}
	$frag =~ s/\$.*//;
	$frag = decode_base64($frag);

	my $body = get($url);
	$body =~ m{>(\{".+\"\})<} || return;

	my $data = decode_html($1);
	$data = unwrap_sjcl($data, $frag);
	return $data;
}

sub dl_cryptbin_do {
	my ($url, $frag) = @_;

	if (!length $frag) {
		_die("cannot decrypt without key in URL fragment");
	}

	my $idx = 0;
	$idx = int $1 if $frag =~ s/,(\d+)$//;

	my $body = get($url);
	$body =~ m{var message='(.+?)';} || return;

	my $data = decode_base64($1);
	$data = unwrap_openssl_aes($data, $frag);
	$data = decode_json($data);
	if (@$data > 1 && !$idx) {
		_warn("only the first file of ".@$data." is shown");
	} elsif (@$data <= $idx) {
		_die("paste only has ".@$data." files");
	}
	$data = $data->[$idx]->{body};
	return $data;
}

sub dl_cryptobin {
	my ($url, $frag) = @_;

	if (!length $frag) {
		$frag = _prompt("password?");
	}
	if (!length $frag) {
		_die("cannot decrypt without key/password");
	}

	my $body = get($url);
	$body =~ m{<textarea name="cipher">(.+?)</textarea} || return;

	my $data = decode_base64($1);
	$data = unwrap_sjcl($data, $frag);
	return $data;
}

sub dl_defuse {
	my ($url, $frag) = @_;

	my $body = get($url);

	if ($body =~ m{<textarea id="paste"[^>]*>(.+?)</textarea>}) {
		my $data = $1;
		$data = decode_entities($data);
		return $data;
	}

	if ($body =~ m{var encrypted = "(.+?)";$}m) {
		if (!length $frag) {
			$frag = _prompt("password?");
		}
		if (!length $frag) {
			_die("cannot decrypt without key/password");
		}

		my $data = $1;
		$data = decode_cescape($data);
		$data = unwrap_defuse($data, $frag);
		return $data;
	}

	return;
}

sub dl_dgl_pastesh {
	my ($url, $frag) = @_;

	my %url = parse_url($url);
	$url{path} =~ m!^/([^.]+)!;
	my $id = $1;

	my $body = get($url) // return;

	$body =~ m{name="content" value="([^"]*?)"} // return;
	my $data = decode_base64($1);

	$body =~ m{name="type" value="([^"]*?)"} // return;
	my $vers = $1;

	$body =~ m{name="etag" value="([^"]*?)"} // return;
	my $atag = decode_base64($1);

	$body =~ m{name="serverkey" value="([^"]*?)"} // return;
	my $serverkey = $1;

	my $passwd = $id . $serverkey . $frag . "https://paste.sh";
	$data = unwrap_pastesh($vers, $data, $passwd, $atag);

	if ($vers eq "v3") {
		# Remove the "Subject:" line (or don't)
		#$data =~ s/^.*?\n\n//m;
	}

	return $data;
}

sub dl_dpaste {
	my ($url, $frag) = @_;

	my $body = get($url);
	if ($body =~ m{<textarea id="copySnippetSource">(.+?)</textarea>}s) {
		return decode_entities($1);
	}
	return;
}

sub dl_ezcrypt {
	Crypt::Digest::SHA1->import("sha1_hex");

	my ($url, $frag) = @_;

	if (!length $frag) {
		_die("cannot decrypt without key in URL fragment");
	}

	my $password;
	my $body;
	my $data;

	$body = get($url);

	while ($body =~ /<div id="askpassword">/) {
		if (-t 0) {
			_debug("paste is password-protected");
			$password = _prompt("password?");
		} else {
			_die("paste is password-protected");
		}
		$body = post($url, p => sha1_hex($password)) || return;
	}

	if ($body =~ /DOCTYPE/) {
		$body =~ m{<input .+ id="data" value="(.+)" />}s || return;
		$data = $1;
	}
	elsif ($body =~ /^\{/) {
		$data = decode_json($body);
		$data = $data->{data};
	}

	$data = decode_base64($data);
	$data = unwrap_ezcrypt($data, $frag);
	return $data;
}

sub dl_kopy {
	my ($url, $frag) = @_;

	my $body = get($url) // return;
	$body = decode_json($body);

	my $data = $body->{data};
	if (($body->{security} // "") eq "encrypted") {
		$data = decode_base64($data);
		$data = unwrap_openssl_aes($data, $frag);
	}
	return $data;
}

sub dl_basic_cryptojs {
	my ($url, $frag) = @_;

	my $data = get($url) // return;
	$data = decode_base64($data);
	$data = unwrap_openssl_aes($data, $frag);
	return $data;
}

sub dl_ncrypt {
	my ($url, $frag) = @_;

	my $body = post($url) // return;
	$body = decode_json($body);

	my $data = $body->{data};
	$data = decode_base64($data);
	$data = unwrap_ncrypt($data, $frag, $body->{cipher});
	return $data;
}

sub dl_privatebin {
	my ($url, $frag) = @_;

	# Trick the server into returning the JSON blob
	$UA->default_header("X-Requested-With" => "JSONHttpRequest");

	my $body = get($url) // return;
	$body = decode_json($body);

	if ($body->{v} && $body->{v} == 2) {
		_trace("redirecting to v2 unwrapper");
		my $data = $body;
		$data = unwrap_privatebin_v2($data, $frag);
		return $data;
	}
	elsif ($body->{data}) {
		_trace("unwrapping old v1 format");
		my $data = $body->{data} // $body;
		$data = unwrap_sjcl($data, $frag);
		$data = decode_base64($data);
		# The example code that comes with js-deflate mistakenly encodes binary
		# data as UTF-8, and of course PrivateBin just used it verbatim.
		# 2020-06-11: Apparently they changed to no longer use deflate.
		if (eval {decode("utf-8", my $tmp = $data, &Encode::FB_CROAK)}) {
			_trace("working around js-deflate binary data bug");
			$data = encode("latin1", decode("utf-8", $data));
		} else {
			_trace("skipping js-deflate workaround");
		}
		$data = decompress_deflate($data);
		return $data;
	}
	else {
		_die("unrecognized PrivateBin format (did they change things up again?)");
	}
}

sub dl_riseup {
	Crypt::Digest::SHA512->import("sha512");
	Crypt::AuthEnc::CCM->import("ccm_decrypt_verify");

	my ($url, $frag) = @_;

	# obtain file parameters

	my $seed = decode_base64($frag);
	$seed = sha512($seed);
	my $key   = substr($seed,  0, 32);
	my $iv    = substr($seed, 32, 16);
	my $ident = substr($seed, 48, 16);
	my $tlen  = 8; # tag size

	# fetch and decrypt file

	$ident = MIME::Base64::encode_base64url($ident);
	my $body = get("https://share.riseup.net/i/$ident") // return;
	$body =~ s/^UP1\0//; # optional anti-hotlink header
	my $tag  = substr($body, -$tlen, $tlen, "");
	$body = ccm_decrypt_verify("AES", $key, $iv, "", $body, $tag)
		// _die("decryption failed");

	# strip JSON header

	if ($body =~ s/^(?:..)*\0\0//) {
		my $header = decode("UTF-16", $&);
		_debug("header: $header");
	}

	return $body;
}

sub dl_sour {
	Crypt::Digest::RIPEMD160->import("ripemd160");

	my ($url, $frag) = @_;

	my $body = get($url) // return;
	my @body = split(/\n\n/, $body);

	my %headers = map {/^(\S+):\s*(.*)$/} split(/\n/, $body[0]);
	_debug("found header: $_='$headers{$_}'") for sort keys %headers;
	if ($headers{chk}) {
		my $k = decode_sour_base64($frag);
		my $c = decode_sour_base64($headers{chk});
		if (ripemd160($k) ne $c) {
			_die("decryption failed (incorrect key)");
		}
	}
	if (($headers{exp} // "") eq "burn_on_read") {
		_warn("this paste is destroyed after first access (burn-on-read)");
	}

	my $data = decode_base64($body[1]);
	$data = unwrap_openssl_aes($data, $frag);
	if (lc($headers{zip} // "") eq "true") {
		$data = decompress_gzip($data);
	}
	return $data;
}

sub dl_ubuntu {
	my ($url, $frag) = @_;

	my $body = get($url);
	if ($body =~ m{<div class="paste"><pre>(.+?)</pre></div>}s) {
		$body = $1;
		$body =~ s{<span>([^<>]*?)</span>}{$1}g;
		$body =~ s{<span class="\w+">([^<>]*?)</span>}{$1}g;
		if ($body =~ /[<>]/) {
			_warn("unmatched HTML tags remain!");
		}
		return decode_entities($body);
	}
	return;
}

sub dl_zerobin {
	my ($url, $frag) = @_;

	if (!length $frag) {
		_die("cannot decrypt without key in URL fragment");
	}

	my $body = get($url) // return;
	if ($body =~ /\bprivatebin\.js/) {
		# recent PrivateBin versions have a different API
		_debug("redirecting to PrivateBin handler");
		goto &dl_privatebin;
	}
	$body =~ m{<div id="cipherdata"[^>]*>(.+)</div>} || return;
	my $data = decode_html($1);
	$data = decode_json($data);
	if (ref $data eq "ARRAY") {
		# early ZeroBin
		$data = $data->[0]->{data};
		$data = unwrap_sjcl($data, $frag);
		$data = decode_base64($data);
		$data = decompress_deflate($data);
	} else {
		# later ZeroBin and early PrivateBin
		$data = $data->{data};
		$data = decode_json($data);
		$data = unwrap_sjcl($data, $frag);
		$data = decode_base64($data);
		if ($body =~ /\bPrivateBin\b/) {
			# (see comment in dl_privatebin)
			$data = decode("utf-8", $data);
		}
		$data = decompress_deflate($data);
	}
	return $data;
}

# }}}
# SITE DATABASE {{{
#
# - supported match fields:
#     scheme, host, path, query, fragment
#     ('host' includes the :port if any)
#
# - each match may be a "string literal", qr/regex literal/, or [array thereof],
#
# - each match field has a corresponding 'to_*' replacement field,
#
# - replacements may use #𝒏 (#0, #1–#9) to reference capture groups of same field,
#   as well as #{field.𝒏} for capture groups of another field.

@SITES = (
	# generic (forced)
	{
		scheme => qr/^sour\+(.+)$/,
		fragment => qr{^/(.+)!(.+)},
		to_scheme => "#1",
		to_path => "#{path.0}/#{fragment.1}",
		to_fragment => "#{fragment.2}",
		parser => \&dl_sour,
	},
	{
		scheme => qr/^privatebin\+(.+)$/,
		to_scheme => "#1",
		parser => \&dl_privatebin,
	},
	{
		scheme => qr/^zerobin\+(.+)$/,
		to_scheme => "#1",
		parser => \&dl_zerobin,
	},
	# domain
	{
		host => "0bin.net",
		parser => \&dl_0bin,
	},
	{
		host => "bpaste.net",
		path => qr!^/\w+/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => "bpa.st",
		path => qr!^/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => qr/^(dark-)?code\.bulix\.org$/,
		to_query => "raw",
	},
	{
		host => "codepad.org",
		path => qr!^/\w+!,
		to_path => "#0/raw.txt",
	},
	{
		host => "cryptb.in",
		parser => \&dl_cryptbin_do,
	},
	{
		host => "cryptbin.com",
		parser => \&dl_cryptbin_do,
	},
	{
		host => "cryptobin.org",
		parser => \&dl_cryptobin,
	},
	{
		host => "paste.debian.net",
		path => qr!^/(\d+)!,
		to_path => "/plain/#1",
	},
	{
		host => "defuse.ca",
		parser => \&dl_defuse,
	},
	{
		host => "dpaste.com",
		path => qr!^/\w+!,
		to_path => "#0.txt",
	},
	{
		host => "dpaste.de",
		path => qr!^/\w+!,
		to_path => "#0/raw/",
	},
	{
		host => "dpaste.org",
		path => qr!^/\w+!,
		parser => \&dl_dpaste,
	},
	{
		host => "www.dropbox.com",
		to_host => "dl.dropboxusercontent.com",
	},
	{
		host => "ezcrypt.it",
		parser => \&dl_ezcrypt,
	},
	{
		host => ["fpaste.org", "paste.fedoraproject.org"],
		to_path => "#0/raw",
	},
	{
		host => "fpaste.org",
		path => qr!^/\w+(?:/\d+)?!,
		to_path => "#0/raw/",
	},
	{
		host => "ghostbin.com",
		path => qr!^/paste/\w+!,
		to_path => "#0/raw",
	},
	{
		host => "gist.github.com",
		to_path => "#0.txt",
	},
	{
		host => "hastebin.com",
		path => qr!^/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => ["irccloud.com", "www.irccloud.com"],
		path => qr!^/pastebin/(\w+)!,
		to_path => "/pastebin/raw/#1",
	},
	{
		host => "paste.joseng.de",
		parser => \&dl_privatebin,
	},
	{
		host => "kopy.io",
		path => qr!^/(\w+)!,
		to_path => "/documents/#1",
		parser => \&dl_kopy,
	},
	{
		host => "paste.lisp.org",
		path => qr!^/display/\d+!,
		to_path => "#0/raw",
	},
	{
		host => "paste.lisp.org",
		path => qr!^/\+!,
		parser => \&dl_recursive,
	},
	{
		host => "paste.lukej.me",
		path => qr!^/(\w+)!,
		to_path => "/raw/#1",
		parser => \&dl_basic_cryptojs,
	},
	{
		host => "pastebin.mozilla.org",
		path => qr!^/(\d+)!,
		to_path => "",
		to_query => "dl=#{path.1}",
	},
	{
		host => "ncry.pt",
		path => qr!^/p/\w+!,
		parser => \&dl_ncrypt,
	},
	{
		host => "paste.nothing.net.nz",
		parser => \&dl_nothingnet,
	},
	{
		host => "paste.opensuse.org",
		path => qr!^/(\d+)!,
		to_path => "/view/raw/#1",
	},
	{
		host => "paste.ee",
		path => qr!^/[pr]/(\w+)!,
		fragment => qr!.+!,
		to_path => "/r/#1",
		parser => \&dl_basic_cryptojs,
	},
	{
		host => "paste.ee",
		path => qr!^/[pr]/(\w+)!,
		to_path => "/r/#1",
	},
	{
		host => "paste.sh",
		parser => \&dl_dgl_pastesh,
	},
	{
		host => ["pastebin.ca", "www.pastebin.ca"],
		path => qr!^(?:/raw)?/(\d+)!,
		to_path => "/raw/#1",
	},
	{
		host => "pastebin.com",
		path => qr!^(?:/index|/raw)?/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => "pastebin.de",
		path => qr!^/(\d+)!,
		to_path => "/download/?id=#1",
	},
	{
		host => "pastie.org",
		path => qr!^(?:/pastes)?/(\d+)!,
		to_path => "/pastes/#1/download",
	},
	{
		host => "pastes.io",
		path => qr!^/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => "paste.pound-python.org",
		path => qr!^/(?:show|raw)/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => "privatebin.net",
		parser => \&dl_privatebin,
	},
	{
		host => "www.refheap.com",
		path => qr!^/\d+!,
		to_path => "#0/raw",
	},
	{
		host => "share.riseup.net",
		parser => \&dl_riseup,
	},
	{
		host => "paste.scratchbook.ch",
		path => qr!^/view/(\w+)$!,
		to_path => "/view/raw/#1",
	},
	{
		host => "fpaste.scsys.co.uk",
		path => qr!^/\d+!,
		to_query => "tx=on",
	},
	{
		host => ["pastebin.ubuntu.com", "paste.ubuntu.com"],
		path => qr!^/p/\w+!,
		parser => \&dl_ubuntu,
	},
	{
		host => "paste.xinu.at",
		path => qr!^/\w+!,
		to_path => "#0",
	},
	{
		host => "paste.dn42.us",
		fragment => qr{^/(.+)!(.+)},
		to_path => "/paste/#{fragment.1}",
		to_fragment => "#{fragment.2}",
		parser => \&dl_sour,
	},
	{
		host => ["ix.io", "sprunge.us"],
		path => qr!^/\w+!,
		to_path => "#0",
		to_query => "",
	},
	{
		host => "termbin.com",
	},
	{
		host => "textbin.net",
		path => qr!^/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => "vomitb.in",
		path => qr!^/(\w+)!,
		to_path => "/raw/#1",
	},
	{
		host => "ptpb.pw",
		path => qr!^/([^/.]+)([/.].*)?!,
		to_path => "/#1",
	},
	# generic (wild guess)
	{
		path => qr{/$},
		fragment => qr{^/(\w{27})!(\w{32,43})$},
		to_path => "#{path.0}api/get/#{fragment.1}",
		to_fragment => "#{fragment.2}",
		note => "probably a PasteBox/Sour.is site based on query & fragment",
		parser => \&dl_sour,
	},
	{
		query => qr/^[0-9a-f]{16}$/,
		fragment => qr{^[0-9A-Za-z+/]{43,44}=?$},
		note => "probably a ZeroBin site based on query & fragment",
		parser => \&dl_zerobin,
	},
);

# }}}

sub usage {
	print "$_\n" for
	"Usage: $::arg0 [-u] <url>",
	"",                       #
	"  -u, --show-url         Output only the URL of raw document",
}

GetOptions(
	"help"		=> sub { usage(); exit; },
	"batch"		=> \$opt_batch,
	"k|insecure"	=> \$opt_insecure,
	"u|show-url"	=> \$opt_show_url,
) or exit 2;

if (!@ARGV) {
	_die("missing URL", 2);
}

if ($opt_insecure) {
	$UA->ssl_opts(verify_hostname => 0);
}

unless ($ENV{PERL_LWP_SSL_CA_FILE} || $ENV{HTTPS_CA_FILE}) {
	$UA->ssl_opts(SSL_ca_file => "/etc/ssl/certs/ca-certificates.crt");
}

$UA->agent("Mozilla/4.0 getpaste/0.42 (nullroute.eu.org)");

for (@ARGV) {
	retrieve_paste($_);
}

exit $::errors;
# vim: ts=8:sw=8:noet:fdm=marker