Subversion Repositories oidplus

Rev

Rev 740 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 740 Rev 748
1 
unit OIDUTILS;
 1 
unit OIDUTILS;
2 
 
 2 
 
3 
(************************************************)
 3 
(************************************************)
4 
(* OIDUTILS.PAS                                 *)
 4 
(* OIDUTILS.PAS                                 *)
5 
(* Author:   Daniel Marschall                   *)
 5 
(* Author:   Daniel Marschall                   *)
6 
(* Revision: 2022-02-14                         *)
 6 
(* Revision: 2022-02-19                         *)
7 
(* License:  Apache 2.0                         *)
 7 
(* License:  Apache 2.0                         *)
8 
(* This file contains:                          *)
 8 
(* This file contains:                          *)
9 
(* - Various OID functions                      *)
 9 
(* - Various OID functions                      *)
10 
(************************************************)
 10 
(************************************************)
11 
 
 11 
 
12 
interface
 12 
interface
13 
 
 13 
 
14 
uses
 14 
uses
15 
  StrList;
 15 
  StrList;
16 
 
 16 
 
17 
function CompareOIDArcList(a, b: PStringList): integer;
 17 
function CompareOIDArcList(a, b: PStringList): integer;
18 
function CompareOID(a, b: string): integer;
 18 
function CompareOID(a, b: string): integer;
19 
procedure ListBubbleSortOID(list: PStringList);
 19 
procedure ListBubbleSortOID(list: PStringList);
20 
function ASN1IDValid(asn1id: string): boolean;
 20 
function ASN1IDValid(asn1id: string): boolean;
- 
 
 21 
function UnicodeLabelValid(unicodeLabel: string): boolean;
21 
 
 22 
 
22 
implementation
 23 
implementation
23 
 
 24 
 
24 
uses
 25 
uses
25 
  VtsFuncs;
 26 
  VtsFuncs;
26 
 
 27 
 
27 
function CompareOIDArcList(a, b: PStringList): integer;
 28 
function CompareOIDArcList(a, b: PStringList): integer;
28 
var
 29 
var
29 
  x, y: PStringList;
 30 
  x, y: PStringList;
30 
  tmp: integer;
 31 
  tmp: integer;
31 
begin
 32 
begin
32 
  x := a;
 33 
  x := a;
33 
  y := b;
 34 
  y := b;
34 
 
 35 
 
35 
  repeat
 36 
  repeat
36 
    if (x = nil) and (y <> nil) then
 37 
    if (x = nil) and (y <> nil) then
37 
    begin
 38 
    begin
38 
      CompareOIDArcList := -1;
 39 
      CompareOIDArcList := -1;
39 
      exit;
 40 
      exit;
40 
    end;
 41 
    end;
41 
 
 42 
 
42 
    if (x <> nil) and (y = nil) then
 43 
    if (x <> nil) and (y = nil) then
43 
    begin
 44 
    begin
44 
      CompareOIDArcList := 1;
 45 
      CompareOIDArcList := 1;
45 
      exit;
 46 
      exit;
46 
    end;
 47 
    end;
47 
 
 48 
 
48 
    if (x = nil) and (y = nil) then
 49 
    if (x = nil) and (y = nil) then
49 
    begin
 50 
    begin
50 
      CompareOIDArcList := 0;
 51 
      CompareOIDArcList := 0;
51 
      exit;
 52 
      exit;
52 
    end;
 53 
    end;
53 
 
 54 
 
54 
    tmp := CompareNumericString(x^.element, y^.element);
 55 
    tmp := CompareNumericString(x^.element, y^.element);
55 
 
 56 
 
56 
    if tmp <> 0 then
 57 
    if tmp <> 0 then
57 
    begin
 58 
    begin
58 
      CompareOIDArcList := tmp;
 59 
      CompareOIDArcList := tmp;
59 
      exit;
 60 
      exit;
60 
    end;
 61 
    end;
61 
 
 62 
 
62 
    x := x^.next;
 63 
    x := x^.next;
63 
    y := y^.next;
 64 
    y := y^.next;
64 
  until false;
 65 
  until false;
65 
end;
 66 
end;
66 
 
 67 
 
67 
function CompareOID(a, b: string): integer;
 68 
function CompareOID(a, b: string): integer;
68 
var
 69 
var
69 
  la, lb: PStringList;
 70 
  la, lb: PStringList;
70 
begin
 71 
begin
71 
  CreateList(la);
 72 
  CreateList(la);
72 
  CreateList(lb);
 73 
  CreateList(lb);
73 
  OIDtoArcList(a, la);
 74 
  OIDtoArcList(a, la);
74 
  OIDtoArcList(b, lb);
 75 
  OIDtoArcList(b, lb);
75 
  CompareOID := CompareOIDArcList(la, lb);
 76 
  CompareOID := CompareOIDArcList(la, lb);
- 
 
 77 
  FreeList(la);
- 
 
 78 
  FreeList(lb);
76 
end;
 79 
end;
77 
 
 80 
 
78 
procedure ListBubbleSortOID(list: PStringList);
 81 
procedure ListBubbleSortOID(list: PStringList);
79 
var
 82 
var
80 
  n, i: integer;
 83 
  n, i: integer;
81 
  a, b: string;
 84 
  a, b: string;
82 
  swapped: boolean;
 85 
  swapped: boolean;
83 
begin
 86 
begin
84 
  n := ListCount(list);
 87 
  n := ListCount(list);
85 
  while n>1 do
 88 
  while n>1 do
86 
  begin
 89 
  begin
87 
    i := 0;
 90 
    i := 0;
88 
    swapped := false;
 91 
    swapped := false;
89 
    while i<n-1 do
 92 
    while i<n-1 do
90 
    begin
 93 
    begin
91 
      a := ListGetElement(list, i);
 94 
      a := ListGetElement(list, i);
92 
      b := ListGetElement(list, i+1);
 95 
      b := ListGetElement(list, i+1);
93 
      if CompareOID(a, b) > 0 then
 96 
      if CompareOID(a, b) > 0 then
94 
      begin
 97 
      begin
95 
        ListSwapElement(list, i, i+1);
 98 
        ListSwapElement(list, i, i+1);
96 
        swapped := true;
 99 
        swapped := true;
97 
      end;
 100 
      end;
98 
      Inc(i);
 101 
      Inc(i);
99 
    end;
 102 
    end;
100 
    if not swapped then break;
 103 
    if not swapped then break;
101 
    Dec(n);
 104 
    Dec(n);
102 
  end;
 105 
  end;
103 
end;
 106 
end;
104 
 
 107 
 
105 
function ASN1IDValid(asn1id: string): boolean;
 108 
function ASN1IDValid(asn1id: string): boolean;
106 
var
 109 
var
107 
  i: integer;
 110 
  i: integer;
108 
  lastChar: char;
 111 
  lastChar: char;
109 
begin
 112 
begin
110 
  (* see Rec. ITU-T X.660 | ISO/IEC 9834-1, clause 7.7  *)
 113 
  (* see Rec. ITU-T X.660 | ISO/IEC 9834-1, clause 7.7  *)
111 
  (* and Rec. ITU-T X.680 | ISO/IEC 8824-1, clause 12.3 *)
 114 
  (* and Rec. ITU-T X.680 | ISO/IEC 8824-1, clause 12.3 *)
112 
 
 115 
 
113 
  ASN1IDValid := false;
 116 
  ASN1IDValid := false;
114 
 
 117 
 
115 
  if Length(asn1id) = 0 then exit; (* may not be empty *)
 118 
  if Length(asn1id) = 0 then exit; (* may not be empty *)
116 
  if not (asn1id[1] in ['a'..'z']) then exit; (* first char must be lowercase *)
 119 
  if not (asn1id[1] in ['a'..'z']) then exit; (* first char must be lowercase *)
117 
 
 120 
 
118 
  lastChar := #0;
 121 
  lastChar := #0;
119 
  for i := 1 to Length(asn1id) do
 122 
  for i := 1 to Length(asn1id) do
120 
  begin
 123 
  begin
121 
    if (lastChar = '-') and (asn1id[i] = '-') then exit; (* may not contain '--' *)
 124 
    if (lastChar = '-') and (asn1id[i] = '-') then exit; (* may not contain '--' *)
122 
    if not (asn1id[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-']) then exit;
 125 
    if not (asn1id[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-']) then exit;
123 
    lastChar := asn1id[i];
 126 
    lastChar := asn1id[i];
124 
  end;
 127 
  end;
125 
  if lastChar = '-' then exit; (* may not end with '-' *)
 128 
  if lastChar = '-' then exit; (* may not end with '-' *)
126 
  ASN1IDValid := true;
 129 
  ASN1IDValid := true;
127 
end;
 130 
end;
- 
 
 131 
 
- 
 
 132 
function UnicodeLabelValid(unicodeLabel: string): boolean;
- 
 
 133 
begin
- 
 
 134 
  UnicodeLabelValid := true;
- 
 
 135 
  (* TODO: Implement *)
- 
 
 136 
 
- 
 
 137 
(*
- 
 
 138 
 
- 
 
 139 
 
- 
 
 140 
function iri_char_valid($c, $firstchar, $lastchar) {
- 
 
 141 
        // see Rec. ITU-T X.660, clause 7.5
- 
 
 142 
 
- 
 
 143 
        if (($firstchar || $lastchar) && ($c == '-')) return false;
- 
 
 144 
 
- 
 
 145 
        if ($c == '-') return true;
- 
 
 146 
        if ($c == '.') return true;
- 
 
 147 
        if ($c == '_') return true;
- 
 
 148 
        if ($c == '~') return true;
- 
 
 149 
        if (($c >= '0') && ($c <= '9') && (!$firstchar)) return true;
- 
 
 150 
        if (($c >= 'A') && ($c <= 'Z')) return true;
- 
 
 151 
        if (($c >= 'a') && ($c <= 'z')) return true;
- 
 
 152 
 
- 
 
 153 
        $v = mb_ord($c);
- 
 
 154 
 
- 
 
 155 
        if (($v >= 0x000000A0) && ($v <= 0x0000DFFE)) return true;
- 
 
 156 
        if (($v >= 0x0000F900) && ($v <= 0x0000FDCF)) return true;
- 
 
 157 
        if (($v >= 0x0000FDF0) && ($v <= 0x0000FFEF)) return true;
- 
 
 158 
        if (($v >= 0x00010000) && ($v <= 0x0001FFFD)) return true;
- 
 
 159 
        if (($v >= 0x00020000) && ($v <= 0x0002FFFD)) return true;
- 
 
 160 
        if (($v >= 0x00030000) && ($v <= 0x0003FFFD)) return true;
- 
 
 161 
        if (($v >= 0x00040000) && ($v <= 0x0004FFFD)) return true;
- 
 
 162 
        if (($v >= 0x00050000) && ($v <= 0x0005FFFD)) return true;
- 
 
 163 
        if (($v >= 0x00060000) && ($v <= 0x0006FFFD)) return true;
- 
 
 164 
        if (($v >= 0x00070000) && ($v <= 0x0007FFFD)) return true;
- 
 
 165 
        if (($v >= 0x00080000) && ($v <= 0x0008FFFD)) return true;
- 
 
 166 
        if (($v >= 0x00090000) && ($v <= 0x0009FFFD)) return true;
- 
 
 167 
        if (($v >= 0x000A0000) && ($v <= 0x000AFFFD)) return true;
- 
 
 168 
        if (($v >= 0x000B0000) && ($v <= 0x000BFFFD)) return true;
- 
 
 169 
        if (($v >= 0x000C0000) && ($v <= 0x000CFFFD)) return true;
- 
 
 170 
        if (($v >= 0x000D0000) && ($v <= 0x000DFFFD)) return true;
- 
 
 171 
        if (($v >= 0x000E1000) && ($v <= 0x000EFFFD)) return true;
- 
 
 172 
 
- 
 
 173 
        // Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked
- 
 
 174 
        // in ISO/IEC 10646 as "(This position shall not be used)"
- 
 
 175 
        // But tool implementers should be tolerate them, since these limitations can be removed in future.
- 
 
 176 
 
- 
 
 177 
        return false;
- 
 
 178 
}
- 
 
 179 
 
- 
 
 180 
function iri_arc_valid($arc, $allow_numeric=true) {
- 
 
 181 
        if ($arc == '') return false;
- 
 
 182 
 
- 
 
 183 
        $m = array();
- 
 
 184 
        if ($allow_numeric && preg_match('@^(\\d+)$@', $arc, $m)) return true; # numeric arc
- 
 
 185 
 
- 
 
 186 
        // Question: Should we strip RTL/LTR characters?
- 
 
 187 
 
- 
 
 188 
        if (mb_substr($arc, 2, 2) == '--') return false; // see Rec. ITU-T X.660, clause 7.5.4
- 
 
 189 
 
- 
 
 190 
        $array = array();
- 
 
 191 
        preg_match_all('/./u', $arc, $array, PREG_SET_ORDER);
- 
 
 192 
        $len = count($array);
- 
 
 193 
        foreach ($array as $i => $char) {
- 
 
 194 
                if (!iri_char_valid($char[0], $i==0, $i==$len-1)) return false;
- 
 
 195 
        }
- 
 
 196 
 
- 
 
 197 
        return true;
- 
 
 198 
}
- 
 
 199 
 
- 
 
 200 
 
- 
 
 201 
*)  
- 
 
 202 
 
- 
 
 203 
end;
128 
 
 204 
 
129 
end.
 205 
end.
130 
 
 206