Subversion Repositories oidplus

unit OIDUTILS;

(************************************************)

(* OIDUTILS.PAS                                 *)

(* Author:   Daniel Marschall                   *)

(* Revision: 2022-02-19                         *)

(* License:  Apache 2.0                         *)

(* This file contains:                          *)

(* - Various OID functions                      *)

(************************************************)

interface

uses

  StrList;

function CompareOIDArcList(a, b: PStringList): integer;

function CompareOID(a, b: string): integer;

procedure ListBubbleSortOID(list: PStringList);

function ASN1IDValid(asn1id: string): boolean;

function UnicodeLabelValid(unicodeLabel: string): boolean;

implementation

uses

  VtsFuncs;

function CompareOIDArcList(a, b: PStringList): integer;

var

  x, y: PStringList;

  tmp: integer;

begin

  x := a;

  y := b;

  repeat

    if (x = nil) and (y <> nil) then

    begin

      CompareOIDArcList := -1;

      exit;

    end;

    if (x <> nil) and (y = nil) then

    begin

      CompareOIDArcList := 1;

      exit;

    end;

    if (x = nil) and (y = nil) then

    begin

      CompareOIDArcList := 0;

      exit;

    end;

    tmp := CompareNumericString(x^.element, y^.element);

    if tmp <> 0 then

    begin

      CompareOIDArcList := tmp;

      exit;

    end;

    x := x^.next;

    y := y^.next;

  until false;

end;

function CompareOID(a, b: string): integer;

var

  la, lb: PStringList;

begin

  CreateList(la);

  CreateList(lb);

  OIDtoArcList(a, la);

  OIDtoArcList(b, lb);

  CompareOID := CompareOIDArcList(la, lb);

  FreeList(la);

  FreeList(lb);

end;

procedure ListBubbleSortOID(list: PStringList);

var

  n, i: integer;

  a, b: string;

  swapped: boolean;

begin

  n := ListCount(list);

  while n>1 do

  begin

    i := 0;

    swapped := false;

    while i<n-1 do

    begin

      a := ListGetElement(list, i);

      b := ListGetElement(list, i+1);

      if CompareOID(a, b) > 0 then

      begin

        ListSwapElement(list, i, i+1);

        swapped := true;

      end;

      Inc(i);

    end;

    if not swapped then break;

    Dec(n);

  end;

end;

function ASN1IDValid(asn1id: string): boolean;

var

  i: integer;

  lastChar: char;

begin

  (* see Rec. ITU-T X.660 | ISO/IEC 9834-1, clause 7.7  *)

  (* and Rec. ITU-T X.680 | ISO/IEC 8824-1, clause 12.3 *)

  ASN1IDValid := false;

  if Length(asn1id) = 0 then exit; (* may not be empty *)

  if not (asn1id[1] in ['a'..'z']) then exit; (* first char must be lowercase *)

  lastChar := #0;

  for i := 1 to Length(asn1id) do

  begin

    if (lastChar = '-') and (asn1id[i] = '-') then exit; (* may not contain '--' *)

    if not (asn1id[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-']) then exit;

    lastChar := asn1id[i];

  end;

  if lastChar = '-' then exit; (* may not end with '-' *)

  ASN1IDValid := true;

end;

function UnicodeLabelValid(unicodeLabel: string): boolean;

begin

  UnicodeLabelValid := true;

  (* TODO: Implement *)

(*

function iri_char_valid($c, $firstchar, $lastchar) {

        // see Rec. ITU-T X.660, clause 7.5

        if (($firstchar || $lastchar) && ($c == '-')) return false;

        if ($c == '-') return true;

        if ($c == '.') return true;

        if ($c == '_') return true;

        if ($c == '~') return true;

        if (($c >= '0') && ($c <= '9') && (!$firstchar)) return true;

        if (($c >= 'A') && ($c <= 'Z')) return true;

        if (($c >= 'a') && ($c <= 'z')) return true;

        $v = mb_ord($c);

        if (($v >= 0x000000A0) && ($v <= 0x0000DFFE)) return true;

        if (($v >= 0x0000F900) && ($v <= 0x0000FDCF)) return true;

        if (($v >= 0x0000FDF0) && ($v <= 0x0000FFEF)) return true;

        if (($v >= 0x00010000) && ($v <= 0x0001FFFD)) return true;

        if (($v >= 0x00020000) && ($v <= 0x0002FFFD)) return true;

        if (($v >= 0x00030000) && ($v <= 0x0003FFFD)) return true;

        if (($v >= 0x00040000) && ($v <= 0x0004FFFD)) return true;

        if (($v >= 0x00050000) && ($v <= 0x0005FFFD)) return true;

        if (($v >= 0x00060000) && ($v <= 0x0006FFFD)) return true;

        if (($v >= 0x00070000) && ($v <= 0x0007FFFD)) return true;

        if (($v >= 0x00080000) && ($v <= 0x0008FFFD)) return true;

        if (($v >= 0x00090000) && ($v <= 0x0009FFFD)) return true;

        if (($v >= 0x000A0000) && ($v <= 0x000AFFFD)) return true;

        if (($v >= 0x000B0000) && ($v <= 0x000BFFFD)) return true;

        if (($v >= 0x000C0000) && ($v <= 0x000CFFFD)) return true;

        if (($v >= 0x000D0000) && ($v <= 0x000DFFFD)) return true;

        if (($v >= 0x000E1000) && ($v <= 0x000EFFFD)) return true;

        // Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked

        // in ISO/IEC 10646 as "(This position shall not be used)"

        // But tool implementers should be tolerate them, since these limitations can be removed in future.

        return false;

}

function iri_arc_valid($arc, $allow_numeric=true) {

        if ($arc == '') return false;

        $m = array();

        if ($allow_numeric && preg_match('@^(\\d+)$@', $arc, $m)) return true; # numeric arc

        // Question: Should we strip RTL/LTR characters?

        if (mb_substr($arc, 2, 2) == '--') return false; // see Rec. ITU-T X.660, clause 7.5.4

        $array = array();

        preg_match_all('/./u', $arc, $array, PREG_SET_ORDER);

        $len = count($array);

        foreach ($array as $i => $char) {

                if (!iri_char_valid($char[0], $i==0, $i==$len-1)) return false;

        }

        return true;

}

*)  

end;

end.