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