Subversion Repositories oidplus

unit WEID_Delphi;

(*

 * WEID<=>OID Converter for Delphi

 * (c) Webfan.de, ViaThinkSoft

 * Revision 2023-08-10

 *)

(*

 * What is a WEID?

 *     A WEID (WEhowski IDentifier) is an alternative representation of an

 *     OID (Object IDentifier) defined by Till Wehowski.

 *     In OIDs, arcs are in decimal base 10. In WEIDs, the arcs are in base 36.

 *     Also, each WEID has a check digit at the end (called WeLuhn Check Digit).

 *

 * The full specification can be found here: https://weid.info/spec.html

 *

 * This converter supports WEID as of Spec Change #11

 *

 * A few short notes:

 *     - There are several classes of WEIDs which have different OID bases:

 *           "Class A" WEID:  weid:root:2-RR-?

 *                            oid:2.999

 *                            WEID class base OID: (OID Root)

 *           "Class B" WEID:  weid:pen:SX0-7PR-?

 *                            oid:1.3.6.1.4.1.37476.9999

 *                            WEID class base OID: 1.3.6.1.4.1

 *           "Class C" WEID:  weid:EXAMPLE-?

 *                            oid:1.3.6.1.4.1.37553.8.32488192274

 *                            WEID class base OID: 1.3.6.1.4.1.37553.8

 *           "Class D" WEID:  weid:example.com:TEST-? is equal to weid:9-DNS-COM-EXAMPLE-TEST-?

 *                            Since the check digit is based on the OID, the check digit is equal for both notations.

 *                            oid:1.3.6.1.4.1.37553.8.9.17704.32488192274.16438.1372205

 *                            WEID class base OID: 1.3.6.1.4.1.37553.8.9.17704

 *     - The last arc in a WEID is the check digit. A question mark is the wildcard for an unknown check digit.

 *       In this case, the converter will return the correct expected check digit for the input.

 *     - The namespace (weid:, weid:pen:, weid:root:) is case insensitive.

 *     - Padding with '0' characters is valid (e.g. weid:000EXAMPLE-3)

 *       The paddings do not count into the WeLuhn check digit.

 *)

interface

(*

Translates a weid to an oid

"weid:EXAMPLE-3" becomes "1.3.6.1.4.1.37553.8.32488192274"

If it failed (e.g. wrong namespace, wrong checksum, etc.) then false is returned.

If the weid ends with '?', then it will be replaced with the checksum,

e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3

*)

function WeidToOid(var weid: string): string;

(*

Converts an OID to WEID

"1.3.6.1.4.1.37553.8.32488192274" becomes "weid:EXAMPLE-3"

*)

function OidToWeid(oid: string): string;

implementation

uses

  SysUtils;

function LastCharPos(const S: string; const Chr: char): integer;

var

  i: Integer;

begin

  for i := length(S) downto 1 do

  begin

    if S[i] = Chr then

    begin

      result := i;

      Exit;

    end;

  end;

  result := 0;

  Exit;

end;

function base_convert_bigint(numstring: string; frombase, tobase: integer): string;

var

  i: Integer;

  frombase_str: string;

  tobase_str: string;

  len: Integer;

  number: string;

  divide: Integer;

  newlen: Integer;

  res: string;

begin

  frombase_str := '';

  for i := 0 to frombase-1 do

  begin

    if i < 10 then

      frombase_str := frombase_str + IntToStr(i)

    else

      frombase_str := frombase_str + Chr(Ord('A') + (i-10));

  end;

  tobase_str := '';

  for i := 0 to tobase-1 do

  begin

    if i < 10 then

      tobase_str := tobase_str + IntToStr(i)

    else

      tobase_str := tobase_str + Chr(Ord('A') + (i-10));

  end;

  len := Length(numstring);

  result := '';

  number := numstring; (* this is a fake "Int8" array (implemented with chars) *)

  for i := 0 to len-1 do

  begin

    number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1);

  end;

  res := '';

  repeat (* Loop until whole number is converted *)

    divide := 0;

    newlen := 0;

    for i := 0 to len-1 do (* Perform division manually (which is why this works with big numbers) *)

    begin

      divide := divide * frombase + Ord(number[i+1]);

      if (divide >= tobase) then

      begin

        number[newlen+1] := Chr(divide div tobase);

        Inc(newlen);

        divide := divide mod tobase;

      end

      else if newlen > 0 then

      begin

        number[newlen+1] := #0;

        Inc(newlen);

      end;

    end;

    len := newlen;

    res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *)

  until newlen = 0;

  result := res;

end;

function weLuhnGetCheckDigit(s: string): integer;

var

  p: integer;

  wrkstr: string;

  c: Char;

  i: Integer;

  sum: integer;

  nbdigits: Integer;

  parity: Integer;

  n: Integer;

  digit: Integer;

begin

  (* Padding zeros don't count to the check digit (December 2021) *)

  s := '-' + s + '-';

  while Pos('-0', s) > 0 do

  begin

    s := StringReplace(s, '-0-', #1, [rfReplaceAll]);

    s := StringReplace(s, '-0', '-', [rfReplaceAll]);

  end;

  s := StringReplace(s, #1, '-0-', [rfReplaceAll]);

  s := Copy(s, 2, Length(s)-2);

  (* remove separators of the WEID string *)

  wrkstr := StringReplace(s, '-', '', [rfReplaceAll]);

  (* Replace 'a' with '10', 'b' with '11', etc. *)

  for c := 'A' to 'Z' do

  begin

    wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10), [rfReplaceAll]);

  end;

  (* At the end, wrkstr should only contain digits! Verify it! *)

  for i := 1 to Length(wrkstr) do

  begin

    if not (wrkstr[i] in ['0'..'9']) then

    begin

      result := -1;

      exit;

    end;

  end;

  (* Now do the standard Luhn algorithm *)

  nbdigits := Length(wrkstr);

  parity := nbdigits and 1; (* mod 2 *)

  sum := 0;

  for n := nbdigits-1 downto 0 do

  begin

    digit := StrToInt(wrkstr[n+1]);

    if (n and 1) <> parity then digit := digit * 2;

    if digit > 9 then digit := digit - 9;

    sum := sum + digit;

  end;

  if sum mod 10 = 0 then

    result := 0

  else

    result := 10 - (sum mod 10);

end;

function WeidToOid(var weid: string): string;

var

  base: string;

  namespace: string;

  p: integer;

  rest: string;

  actual_checksum: string;

  expected_checksum: integer;

  complete: string;

  oidstr: string;

  arc: string;

  domainpart: string;

  tmp: string;

begin

  p := LastCharPos(weid,':');

  namespace := Copy(weid, 1, p);

  rest := Copy(weid, p+1, Length(weid)-p);

  namespace := LowerCase(namespace); (* namespace is case insensitive *)

  if Copy(namespace, 1, 5) = 'weid:' then

  begin

    tmp := Copy(namespace, 1, Length(namespace)-1);

    p := Pos(':', tmp, 5);

    Delete(tmp, 1, p);

    if pos('.', tmp) > 0 then

    begin

      (* Spec Change 10: Class D / Domain-WEID *)

      if pos(':', tmp) > 0 then

      begin

        result := '';

        exit;

      end;

      domainpart := '';

      while tmp <> '' do

      begin

        p := Pos('.', tmp);

        if p = 0 then

        begin

          domainpart := tmp + '-' + domainpart;

          break;

        end

        else

        begin

          domainpart := Copy(tmp, 1, p-1) + '-' + domainpart;

          Delete(tmp, 1, p);

        end;

      end;

      weid := 'weid:9-DNS-' + UpperCase(Domainpart) + Rest;

      result := WeidToOid(weid);

      exit;

    end;

  end;

  if Copy(namespace, 1, 7) = 'weid:x-' then

  begin

        (* Spec Change 11: Proprietary Namespaces *)

    result := '[Proprietary WEID Namespace]';

    Exit;

  end

  else if namespace = 'weid:' then

  begin

    (* Class C *)

    base := '1-3-6-1-4-1-SZ5-8';

  end

  else if namespace = 'weid:pen:' then

  begin

    (* Class B *)

    base := '1-3-6-1-4-1';

  end

  else if namespace = 'weid:root:' then

  begin

    (* Class A *)

    base := '';

  end

  else

  begin

    (* Wrong namespace *)

    result := '';

    Exit;

  end;

  weid := rest;

  if base <> '' then

    complete := base + '-' + weid

  else

    complete := weid;

  p := LastCharPos(complete, '-');

  actual_checksum := Copy(complete, p+1, 1);

  complete := Copy(complete, 1, p-1);

  expected_checksum := weLuhnGetCheckDigit(complete);

  if (actual_checksum <> '?') then

  begin

    if actual_checksum <> IntToStr(expected_checksum) then

    begin

      result := ''; (* wrong checksum *)

      Exit;

    end;

  end

  else

  begin

    (* If checksum is '?', it will be replaced by the actual checksum, *)

    (* e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3                      *)

    weid := StringReplace(weid, '?', IntToStr(expected_checksum), [rfReplaceAll]);

  end;

  oidstr := '';

  while true do

  begin

    p := Pos('-', complete);

    if p = 0 then p := Length(complete)+1;

    arc := Copy(complete, 1, p-1);

    Delete(complete, 1, p);

    oidstr := oidstr + base_convert_bigint(arc, 36, 10) + '.';

    if complete = '' then break;

  end;

  oidstr := Copy(oidstr, 1, Length(oidstr)-1);

  weid := LowerCase(namespace) + UpperCase(weid); (* add namespace again *)

  result := oidstr;

end;

function OidToWeid(oid: string): string;

var

  is_class_a: boolean;

  is_class_b: boolean;

  is_class_c: boolean;

  weidstr: string;

  checksum: string;

  namespace: string;

  p: Integer;

  cd: Integer;

  res: string;

begin

  if Copy(oid,1,1) = '.' then

    Delete(oid,1,1); (* remove leading dot *)

  if oid <> '' then

  begin

    weidstr := '';

    while true do

    begin

      p := Pos('.', oid);

      if p = 1 then

      begin

        Delete(oid, 1, 1);

      end

      else if p > 0 then

      begin

        weidstr := weidstr + base_convert_bigint(Copy(oid, 1, p-1),10,36) + '-';

        Delete(oid, 1, p);

      end

      else

      begin

        weidstr := weidstr + base_convert_bigint(oid,10,36) + '-';

        break;

      end;

    end;

    weidstr := Copy(weidstr, 1, Length(weidstr)-1);

  end

  else

  begin

    weidstr := '';

  end;

  is_class_c := (Pos('1-3-6-1-4-1-SZ5-8-', weidstr) = 1) or

                (weidstr = '1-3-6-1-4-1-SZ5-8');

  is_class_b := ((Pos('1-3-6-1-4-1-', weidstr) = 1) or

                (weidstr = '1-3-6-1-4-1'))

                and not is_class_c;

  is_class_a := not is_class_b and not is_class_c;

  cd := weLuhnGetCheckDigit(weidstr);

  if cd < 0 then

  begin

    result := weidstr;

    exit;

  end;

  checksum := IntToStr(cd);

  if is_class_c then

  begin

    Delete(weidstr, 1, Length('1-3-6-1-4-1-SZ5-8-'));

    namespace := 'weid:';

  end

  else if is_class_b then

  begin

    Delete(weidstr, 1, Length('1-3-6-1-4-1-'));

    namespace := 'weid:pen:';

  end

  else if is_class_a then

  begin

    (* weidstr stays *)

    namespace := 'weid:root:';

  end

  else

  begin

    (* should not happen *)

    result := '';

    Exit;

  end;

  res := namespace;

  if weidstr = '' then

    res := res + checksum

  else

    res := res + weidstr + '-' + checksum;

  result := res;

end;

end.