From 6649e8dffcbff86fdb77c2ca4f160e6688966846 Mon Sep 17 00:00:00 2001
From: Michael Ortmann <41313082+michaelortmann@users.noreply.github.com>
Date: Sun, 7 Jul 2024 22:28:49 +0200
Subject: [PATCH] Add tcl pbkdf2 function

 Patch by: michaelortmann

Useful for tcl scripts that add SASL SCRAM mechanism which, when implemented in Tcl, are very slow. This PR will help with a fast replacement function exported by eggdrop.

The new tcl function pbkdf2() returns as hexadecimal string by default and -bin by option, which is similar, to what tcllibs sha256() does (older tcllibs md5 had it the other way around), see https://core.tcl-lang.org/tcllib/doc/trunk/embedded/md/tcllib/files/modules/sha1/sha256.md
---
 doc/sphinx_source/using/tcl-commands.rst | 20 +++++++
 src/mod/pbkdf2.mod/pbkdf2.c              | 18 +-----
 src/mod/pbkdf2.mod/tclpbkdf2.c           | 70 ++++++++++++++++++++++++
 3 files changed, 92 insertions(+), 16 deletions(-)
 create mode 100644 src/mod/pbkdf2.mod/tclpbkdf2.c

diff --git a/doc/sphinx_source/using/tcl-commands.rst b/doc/sphinx_source/using/tcl-commands.rst
index 6a662052c..339c728c3 100644
--- a/doc/sphinx_source/using/tcl-commands.rst
+++ b/doc/sphinx_source/using/tcl-commands.rst
@@ -2200,6 +2200,26 @@ setflags <dir> [<flags> [channel]]
 
   Module: filesys
 
+PBKDF2 Module
+-------------
+
+^^^^^^^^^^^^^^^
+encpass2 <pass>
+^^^^^^^^^^^^^^^
+
+
+  Returns: a hash in the format of "$pbkdf2-<digest>$rounds=<rounds>$<salt>$<hash>" where digest is the digest set in the config variable pbkdf2-method, rounds is the number of rounds set in the config variable pbkdf2-rounds, salt is the base64 salt used to generate the hash, and hash is the generated base64 hash.
+
+  Module: pbkdf2
+
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+pbkdf2 [-bin] <pass> <salt> <rounds> <digest>
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+  Returns: a derived key from the provided "pass" string using "salt" and "rounds" count as specified in RFC 2898 as a hexadecimal string. Using the optional -bin flag will return the result as binary data.
+
+  Module: pbkdf2
+
 Miscellaneous Commands
 ----------------------
 
diff --git a/src/mod/pbkdf2.mod/pbkdf2.c b/src/mod/pbkdf2.mod/pbkdf2.c
index 169d92bc8..2eda85038 100644
--- a/src/mod/pbkdf2.mod/pbkdf2.c
+++ b/src/mod/pbkdf2.mod/pbkdf2.c
@@ -8,6 +8,7 @@
  */
 
 #include "src/mod/module.h"
+#include "src/mod/pbkdf2.mod/tclpbkdf2.c"
 
 #if OPENSSL_VERSION_NUMBER >= 0x1000000fL /* 1.0.0 */
 #define MODULE_NAME "encryption2"
@@ -108,7 +109,7 @@ static char *pbkdf2_hash(const char *pass, const char *digest_name,
                          digestlen, buf)) {
     explicit_bzero(buf, digestlen);
     explicit_bzero(out, outlen);
-    putlog(LOG_MISC, "*", "PBKDF2 error: PKCS5_PBKDF2_HMAC(): %s.",
+    putlog(LOG_MISC, "*", "PBKDF2 key derivation error: %s.",
            ERR_error_string(ERR_get_error(), NULL));
     nfree(buf);
     return NULL;
@@ -223,21 +224,6 @@ static char *pbkdf2_verify(const char *pass, const char *encrypted)
   return (char *) encrypted;
 }
 
-static int tcl_encpass2 STDVAR
-{
-  BADARGS(2, 2, " string");
-  if (strlen(argv[1]) > 0)
-    Tcl_AppendResult(irp, pbkdf2_encrypt(argv[1]), NULL);
-  else
-    Tcl_AppendResult(irp, "", NULL);
-  return TCL_OK;
-}
-
-static tcl_cmds my_tcl_cmds[] = {
-  {"encpass2", tcl_encpass2},
-  {NULL,       NULL}
-};
-
 static tcl_ints my_tcl_ints[] = {
   {"pbkdf2-re-encode", &pbkdf2_re_encode, 0},
   {"pbkdf2-rounds",    &pbkdf2_rounds,    0},
diff --git a/src/mod/pbkdf2.mod/tclpbkdf2.c b/src/mod/pbkdf2.mod/tclpbkdf2.c
new file mode 100644
index 000000000..8fa7bf8dd
--- /dev/null
+++ b/src/mod/pbkdf2.mod/tclpbkdf2.c
@@ -0,0 +1,70 @@
+/* SPDX-License-Identifier: GPL-2.0-only */
+/*
+ * tclpbkdf2.c -- tcl functions for pbkdf2.mod
+ *
+ * Written by thommey and Michael Ortmann
+ *
+ * Copyright (C) 2017 - 2024 Eggheads Development Team
+ */
+
+#include <openssl/err.h>
+#include <string.h>
+
+static char *pbkdf2_encrypt(const char *);
+
+static int tcl_encpass2 STDVAR
+{
+  BADARGS(2, 2, " string");
+  Tcl_SetResult(irp, pbkdf2_encrypt(argv[1]), TCL_STATIC);
+  return TCL_OK;
+}
+
+static int tcl_pbkdf2 STDVAR
+{
+  int hex, digestlen, i;
+  unsigned int rounds;
+  const EVP_MD *digest;
+  unsigned char buf[256];
+  char buf_hex[256];
+  Tcl_Obj *result = 0;
+
+  BADARGS(5, 6, " ?-bin? pass salt rounds digest");
+  if (argc == 6) {
+    if (!strcmp(argv[1], "-bin"))
+      hex = 0;
+    else {
+      Tcl_AppendResult(irp, "bad option ", argv[1], ": must be -bin", NULL);
+      return TCL_ERROR;
+    }
+  }
+  else
+    hex = 1;
+  rounds = atoi(argv[3 + !hex]);
+  digest = EVP_get_digestbyname(argv[4 + !hex]);
+  if (!digest) {
+    Tcl_AppendResult(irp, "PBKDF2 error: Unknown message digest '", argv[4 + !hex], "'.", NULL);
+    return TCL_ERROR;
+  }
+  digestlen = EVP_MD_size(digest);
+  if (!PKCS5_PBKDF2_HMAC(argv[1 + !hex], strlen(argv[1 + !hex]), (const unsigned char *) argv[2+ !hex], strlen(argv[2 + !hex]), rounds, digest, digestlen, buf)) {
+    Tcl_AppendResult(irp, "PBKDF2 key derivation error: ", ERR_error_string(ERR_get_error(), NULL), ".", NULL);
+    return TCL_ERROR;
+  }
+  if (hex) {
+    for (i = 0; i < digestlen; i++)
+      sprintf(buf_hex + (i * 2), "%.2X", buf[i]);
+    result = Tcl_NewByteArrayObj((unsigned char *) buf_hex, digestlen * 2);
+    explicit_bzero(buf_hex, digestlen * 2);
+  }
+  else
+    result = Tcl_NewByteArrayObj(buf, digestlen);
+  explicit_bzero(buf, digestlen);
+  Tcl_SetObjResult(irp, result);
+  return TCL_OK;
+}
+
+static tcl_cmds my_tcl_cmds[] = {
+  {"encpass2", tcl_encpass2},
+  {"pbkdf2",   tcl_pbkdf2},
+  {NULL,       NULL}
+};