From 703ebc7be648cf5beb067a8e1058d21774225ed8 Mon Sep 17 00:00:00 2001
From: Thomas Hochstein <thh@thh.name>
Date: Sat, 10 May 2025 11:37:37 +0200
Subject: [PATCH] Add canlockcheck.pl

Signed-off-by: Thomas Hochstein <thh@thh.name>
---
 canlockcheck.pl | 83 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 83 insertions(+)
 create mode 100644 canlockcheck.pl

diff --git a/canlockcheck.pl b/canlockcheck.pl
new file mode 100644
index 0000000..5719eea
--- /dev/null
+++ b/canlockcheck.pl
@@ -0,0 +1,83 @@
+#! /usr/bin/perl -w
+#
+# canlockcheck.pl
+#
+# Check whether Cancel-Lock and Cancel-Key match.
+#
+# Copyright (c) 2023 Thomas Hochstein <thh@thh.name>
+
+use MIME::Base64();
+use Digest::SHA();
+use Digest::MD5();
+use Getopt::Long qw(GetOptions);
+Getopt::Long::config ('bundling');
+
+my $VERSION = "0.1";
+
+# read commandline options ############
+my ($OptCanLock,$OptCanKey);
+GetOptions ('l|lock=s'  => \$OptCanLock,
+            'k|key=s'   => \$OptCanKey,
+            'V|version' => \&ShowVersion) or exit 1;
+
+# subroutines #########################
+
+### display version information and exit
+sub ShowVersion {
+  print "canlockcheck v$VERSION\n";
+  print "Copyright (c) 2023 Thomas Hochstein <thh\@thh.name>\n";
+  print "This program is free software; you may redistribute it ".
+        "and/or modify it under the same terms as Perl itself.\n";
+  exit;
+};
+
+sub verify_cancel_key($$) {
+  my $cancel_lock = shift;
+  my $cancel_key  = shift;
+
+  my %lock;
+  for my $l(split(/\s+/, $cancel_lock)) {
+    unless($l =~ m/^(sha512|sha256|sha1|md5):(\S+)/) {
+      printf ("Invalid Cancel-Lock syntax '%s'\n", $l);
+      next;
+    }
+    $lock{$2} = $1;
+   }
+
+  for my $k(split(/\s+/, $cancel_key)) {
+    unless($k =~ m/^(sha512|sha256|sha1|md5):(\S+)/) { 
+      printf ("Invalid Cancel-Key syntax '%s'\n", $k);
+      next;
+    }
+
+    my $key;
+    if ($1 eq 'sha512') {
+      $key = Digest::SHA::sha512($2);
+    } elsif ($1 eq 'sha256') {
+       $key = Digest::SHA::sha256($2);
+    } elsif($1 eq 'sha1') {
+       $key = Digest::SHA::sha1($2);
+    } elsif ($1 eq 'md5') {
+       $key = Digest::MD5::md5($2);
+    }
+    $key = MIME::Base64::encode_base64($key, '');
+
+    if (exists($lock{$key})) {
+      return sprintf("Cancel-Key %s:%s matches Cancel-Lock %s:%s.", $1, $2, $lock{$key}, $key);
+    }
+  }
+
+ return 'No Cancel-Key matches any Cancel-Lock.';
+}
+
+# Main program ########################
+
+if (!$OptCanLock or !$OptCanKey) {
+  print "canlockcheck -l <Cancel-Lock> -k <Cancel-Key>\n";
+  exit 2;
+}
+
+my $result = &verify_cancel_key($OptCanLock, $OptCanKey);
+
+printf ("%s\n", $result);
+exit;