 |
OpenVMS Programming Concepts Manual
33.6.2 Example Using Dialogue Mode (Pascal)
This more complex example can respond to an arbitrary itemset
provided in the ACM communications buffer by successive calls to the
SYS$ACM[W] system service. In particular, the item list allocated to respond
to a given itemset is automatically made large
enough to respond to each possible itemset entry
if it happens to be an input itemset entry.
This differs from the programming tactic used in Section 33.5.3 because
variable sizing of automatic (stack) variables is available in Pascal
but not in BLISS.
This theoretical example shows support for a fingerprint reader. It is
written to demonstrate programming techniques, rather than to
correspond to a particular hardware product.
| Line |
Activity |
Special Notes |
|
22
|
Function AUTHENTICATE
|
Called by one line at the very end.
|
|
180
|
Function RESPOND
|
Provide input requested by SYS$ACM[W].
|
|
239
|
Function RECURSE_OVER_ITEMS
|
Mandatory specification of attributes. Handle one possible input and
many possible output entries.
|
|
276
|
Procedure WRITE_ITEM_PLAIN
|
Write to the terminal.
|
|
298
|
Procedure SET_BUFFER
|
Use input code rather than reading terminal.
|
|
321
|
Fail on non-text other than FINGERPRINT_READIT
|
No ACME should request any other non-text.
|
|
358
|
Read a fingerprint
|
Use the hardware.
|
|
438
|
Synthesize principal name
|
Call SET_BUFFER with the proper string.
|
|
496
|
Prompt the user for other text
|
If any ACME agent requests prompt, it may do so; other ACME agents may
request additional information.
|
|
587
|
Fill in the item list
|
Store input text.
|
|
608
|
Process output item set entries
|
Send output text to the terminal.
|
|
750
|
Call SYS$ACM with response
|
When recursion is done, send it.
|
|
761
|
Make the initial call to RECURSE_OVER_ITEMS
|
Initialize for this iteration and start recursion.
|
|
775
|
Learn the ACME_ID of the fingerprint ACME
|
ACME-specific item codes are specific to an ACME.
|
|
805
|
Make an initial SYS$ACMW call
|
Start with invariant information.
|
|
828
|
Loop calling RESPOND
|
So long as the status is ACME$_OPINCOMPL.
|
|
863
|
Close channels
|
Clean-up of open channels.
|
|
885
|
Return status to caller
|
Failures exited earlier.
|
2 'sys$Library:PASCAL$LIB_ROUTINES')]
3 PROGRAM ACM_SHOPFLOOR(OUTPUT);
4 { }
5 { AUTHENTICATE - major subroutine of this module }
6 { }
7 { This function is called with a USER_INDEX, indicating which }
8 { of 10 buttons on the shop floor kiosk was pushed, and thus }
9 { which of ten employees is to be authenticated. }
10 { }
11 TYPE PRINCIPAL_INDEX_TYPE = (
12 PRINCIPAL_1,
13 PRINCIPAL_2,
14 PRINCIPAL_3,
15 PRINCIPAL_4,
16 PRINCIPAL_5,
17 PRINCIPAL_6,
18 PRINCIPAL_7,
19 PRINCIPAL_8,
20 PRINCIPAL_9,
21 PRINCIPAL_10 );
22 { }
23 { This subroutine translates each of the 10 possible index }
24 { values into one of ten generic principal names. To avoid }
25 { changes to this client program, those principal names are }
26 { mapped into the principal names actually corresponding to }
27 { individual names within the ACME Server, so that a single }
28 { data file can be modified by a designated administrator }
29 { without changing the client software. }
30 { }
31 { }
32 { After the Principal Name has been determined, the user must }
33 { be authenticated. At some kiosks there is a fingerprint }
34 { reader that will be used for authentication, while at the }
35 { spray painting station a keyboard is always used because }
36 { employees are wearing rubber gloves. For some sensitive }
37 { combinations of Principal Name and kiosk, a fingerprint }
38 { and passwords might both be required. These variations, }
39 { however, are determined by ACMEs within the ACME Server, }
40 { and this client code merely authenticates using whatever }
41 { method might be specified in the Context Area returned by }
42 { successive SYS$ACM calls. }
43 { }
44 CONST
45 FINGERPRINT_READIT = 32770; { from the Fingerprint ACME }
46 { }
47 { After authentication it is also possible that password }
48 { expirations may need to be handled, in which case even in }
49 { situations where a fingerprint would normally be sufficient,}
50 { the user will actually have to engage in typing. Whether }
51 { users who normally authenticate with a fingerprint even }
52 { have a password is an administrative issue enforced by }
53 { configuration of the ACMEs. As in the authentication step, }
54 { this client software just implements whatever mechanism is }
55 { specified in the Context Area returned by successive }
56 { SYS$ACM calls. }
57 { }
58 FUNCTION AUTHENTICATE ( PRINCIPAL_INDEX : PRINCIPAL_INDEX_TYPE ):BOOLEAN;
59 TYPE
60 ACMECB_PTR = ^ACMECB$TYPE;
61 CHANNEL_TYPE = [WORD] 0..65535;
62 VAR
63 FINGERPRINT_READER_CHANNEL : CHANNEL_TYPE VALUE 0;
64 TERMINAL_CHANNEL : CHANNEL_TYPE VALUE 0;
65 MY_LOGON_TYPE : INTEGER VALUE ACME$K_LOCAL;
66 MY_DIALOGUE_SUPPORT : INTEGER
67 VALUE ACMEDLOGFLG$M_INPUT + ACMEDLOGFLG$M_NOECHO;
68 { }
69 { We rely on an initial query to determine the ACME ID }
70 { of the Fingerprint ACME in the current running system. }
71 { We use that ACME ID to compare against ACMECB$L_ACME_ID }
72 { in the ACME Communications Buffer to determine whether }
73 { an ACME-specific input item set is one created by the }
74 { Fingerprint ACME, because ACME-specific item codes must }
75 { qualified by the originating ACME. }
76 { }
77 { Field ACMECB$L_ACME_ID.ACMEID$V_ACME_NUM will be the }
78 { actual basis of comparison, because it is sufficient to }
79 { identify a particular ACME and the other fields within }
80 { an ACME ID might change between when our query call }
81 { completes and when we make our authenticate call. }
82 { }
83 { We make our query against the reserved ID value of 0, }
84 { to gather information about the ACME Agents. This query }
85 { is actually handled by the SYS$ACMW system service. }
86 { }
87 { Data elements for the query for ACME ID }
88 { }
89 { Addresses of these elements will be set into item list }
90 { ACM_QUERY_ITMLST by procedural code below. }
91 { }
92 SYS$ACM_ACME_ID : INTEGER VALUE 0;
93 ACME_QUERY_ACME_NAME : INTEGER VALUE ACME$K_QUERY_ACME_NAME;
94 FINGERPRINT_ACME_NAME : STRING(16) VALUE 'FINGERPRINT_ACME';
95 ACME_TARGET_DOI_ID : INTEGER VALUE ACME$K_QUERY_ACME_ID;
96 FINGERPRINT_ACME_ID : ACMEID$TYPE;
97 { }
98 { Item list for the Query }
99 { }
100 ACM_QUERY_ITMLST : ARRAY[0..5] OF ILE3$TYPE
101 VALUE [ 0:[ILE3$W_LENGTH:4;
102 ILE3$W_CODE:ACME$_TARGET_DOI_ID;
103 ILE3$PS_BUFADDR:0;
104 ILE3$PS_RETLEN_ADDR:NIL];
105 1:[ILE3$W_LENGTH:4;
106 ILE3$W_CODE:ACME$_QUERY_KEY_TYPE;
107 ILE3$PS_BUFADDR:0;
108 ILE3$PS_RETLEN_ADDR:NIL];
109 2:[ILE3$W_LENGTH:16;
110 ILE3$W_CODE:ACME$_QUERY_KEY_VALUE;
111 ILE3$PS_BUFADDR:0;
112 ILE3$PS_RETLEN_ADDR:NIL];
113 3:[ILE3$W_LENGTH:4;
114 ILE3$W_CODE:ACME$_QUERY_TYPE;
115 ILE3$PS_BUFADDR:0;
116 ILE3$PS_RETLEN_ADDR:NIL];
117 4:[ILE3$W_LENGTH:4;
118 ILE3$W_CODE:ACME$_QUERY_DATA;
119 ILE3$PS_BUFADDR:0;
120 ILE3$PS_RETLEN_ADDR:NIL];
121 5:[ILE3$W_LENGTH:0;
122 ILE3$W_CODE:0;
123 ILE3$PS_BUFADDR:0;
124 ILE3$PS_RETLEN_ADDR:NIL]];
125 { }
126 { Item list for initial Authentication call }
127 { }
128 MY_ACM_ITMLST_A : ARRAY[0..2] OF ILE3$TYPE
129 VALUE [ 0:[ILE3$W_LENGTH:4;
130 ILE3$W_CODE:ACME$_LOGON_TYPE;
131 ILE3$PS_BUFADDR:0;
132 ILE3$PS_RETLEN_ADDR:NIL];
133 1:[ILE3$W_LENGTH:4;
134 ILE3$W_CODE:ACME$_DIALOGUE_SUPPORT;
135 ILE3$PS_BUFADDR:0;
136 ILE3$PS_RETLEN_ADDR:NIL];
137 2:[ILE3$W_LENGTH:0;
138 ILE3$W_CODE:0;
139 ILE3$PS_BUFADDR:0;
140 ILE3$PS_RETLEN_ADDR:NIL]];
141 { }
142 { Variables used both inside and outside Function RESPOND }
143 { }
144 MY_ACMESB : ACMESB$TYPE;
145 MY_CONTXT : ACMECB_PTR;
146 MY_STATUS : UNSIGNED;
147 TRASH_STATUS : UNSIGNED;
148 { }
149 { The ITEMSET array we will read }
150 { }
151 TYPE
152 { }
153 { A string longer than we will ever see, defined to }
154 { avoid exceeding Pascal's 2**16-1 limit on string }
155 { length. }
156 { }
157 CHAR_ARRAY_TYPE = PACKED ARRAY [1..65535]
158 OF CHAR;
159 CHAR_ARRAY_TYPE_POINTER = ^CHAR_ARRAY_TYPE;
160 { }
161 { An array longer than we will ever see, defined to }
162 { avoid: }
163 { }
164 { "%PASCAL-E-SIZGTRMAX, Size exceeds MAXINT bits". }
165 { }
166 ITEMSET_ARRAY_TYPE =
167 PACKED ARRAY [1..MAXINT DIV (ACMEIS$K_LENGTH*8)]
168 OF ACMEITMSET$TYPE;
169 ITEMSET_ARRAY_TYPE_POINTER = ^ITEMSET_ARRAY_TYPE;
170 VAR
171 ITEMSET_ARRAY : ITEMSET_ARRAY_TYPE_POINTER;
172 { }
173 { A special declaration is required in order to }
174 { Synchronize on an ACM Status Block }
175 { }
176 [ASYNCHRONOUS,EXTERNAL(SYS$SYNCH)] FUNCTION $SYNCH_ACMESB (
177 %IMMED EFN : UNSIGNED := %IMMED 0;
178 VAR IOSB : [VOLATILE] ACMESB$TYPE := %IMMED 0)
179 : INTEGER; EXTERNAL;
180 { }
181 { Function to fill in responses to input itemsets }
182 { }
183 { Input itemsets will require buffer space, and }
184 { although each input itemset will use no more }
185 { than 65535 bytes, the number of input itemsets }
186 { provided in a single dialogue step is not }
187 { bounded. }
188 { }
189 { Therefore we invoke this function recursively }
190 { each time we encounter an input itemset, }
191 { making use of a conformant parameter to }
192 { allocate the appropriate length buffer. When }
193 { all itemsets have been processed, we make our }
194 { continuation call to $ACM from the deepest }
195 { level of recursion (when all buffers are still }
196 { intact), and then return from function RESPOND }
197 { entirely to wait for completion of the call. }
198 { }
199 { This recursive approach using stack-based }
200 { buffers is fine for operation on the expandable }
201 { main VMS user-mode stack, but an application }
202 { operating on non-expandable stacks, such as }
203 { non-initial stack from VAX Ada or DECthreads, }
204 { should obviously use iteration and heap-based }
205 { explicit allocation instead. }
206 { }
207 FUNCTION RESPOND ( ITEMSET_COUNT : INTEGER ):INTEGER;
208 { }
209 { The Item List we will write for use on the }
210 { next call to SYS$ACM will never have more }
211 { entries than the Itemset List we received }
212 { in the ACM Communications Buffer from the }
213 { previous call to SYS$ACM, so we choose that }
214 { maximum size for our item list. }
215 { }
216 TYPE
217 ITEM_LIST_TEMPLATE ( UPPER_BOUND : INTEGER )
218 = ARRAY [1..UPPER_BOUND] OF ILE3$TYPE;
219 VAR
220 ITEM_LIST : ITEM_LIST_TEMPLATE ( ITEMSET_COUNT + 1 );
221 EACH_ITEM : INTEGER VALUE 1;
222 { }
223 { Each invocation of RECURSE_OVER_ITEMS will }
224 { allocate an automatic (stack-based) buffer. }
225 { }
226 TYPE
227 INPUT_BUFFER_TEMPLATE ( MAX_SIZE : INTEGER )
228 = PACKED ARRAY [1..MAX_SIZE] OF CHAR;
229 { }
230 { Variables for parsing the Itemset List }
231 { }
232 VAR
233 CHAR_ARRAY_LENGTH_1 : INTEGER;
234 CHAR_ARRAY_POINTER_1 : CHAR_ARRAY_TYPE_POINTER;
235 CHAR_ARRAY_LENGTH_2 : INTEGER;
236 CHAR_ARRAY_POINTER_2 : CHAR_ARRAY_TYPE_POINTER;
237 EACH_ITEMSET : INTEGER VALUE 1;
238 INPUT_IOSB, CONFIRM_IOSB : IOSB$TYPE;
239 { }
240 { RECURSE_OVER_ITEMS }
241 { }
242 { This function gets called: }
243 { }
244 { 1. Once with a parameter of zero at the }
245 { start of processing an Itemset List. }
246 { }
247 { 2. Recursively as each input itemset is }
248 { encountered in the Itemset List. }
249 { }
250 { Multiple output itemsets are processed at a }
251 { single recursion level until the end of the }
252 { Itemset List or until an input itemset }
253 { is found. }
254 FUNCTION RECURSE_OVER_ITEMS ( MAX_SIZE : INTEGER ):INTEGER;
255 { }
256 { The buffer we will use for this input item }
257 { }
258 { The INPUT_BUFFER lifetime needs only be for }
259 { the lifetime of RECURSE_OVER_ITEMS because it }
260 { is filled by SYS$QIOW at this recursion }
261 { level and provided as input to SYS$ACM at }
262 { the innermost recursion level. }
263 { }
264 VAR
265 { }
266 { We use MAX_SIZE+1 to avoid the error: }
267 { }
268 { %PAS-F-LOWGTRHIGH, low-bound exceeds high-bound }
269 { }
270 { when MAX_SIZE is 0. }
271 { }
272 INPUT_BUFFER : INPUT_BUFFER_TEMPLATE ( MAX_SIZE+1 );
273 CONFIRM_BUFFER : INPUT_BUFFER_TEMPLATE ( MAX_SIZE+1 );
274 QIO_FUNC : INTEGER;
275 { }
276 PROCEDURE WRITE_ITEM_PLAIN;
277 BEGIN { WRITE_ITEM_PLAIN }
278 IF CHAR_ARRAY_POINTER_1 <> NIL
279 THEN
280 IF CHAR_ARRAY_LENGTH_1 = 0
281 THEN
282 WRITELN
283 ELSE
284 WRITELN (
285 CHAR_ARRAY_POINTER_1^[1..
286 CHAR_ARRAY_LENGTH_1] );
287 IF CHAR_ARRAY_POINTER_2 <> NIL
288 THEN
289 IF CHAR_ARRAY_LENGTH_2 = 0
290 THEN
291 WRITELN
292 ELSE
293 WRITELN (
294 CHAR_ARRAY_POINTER_2^[1..
295 CHAR_ARRAY_LENGTH_2] );
296 END; { WRITE_ITEM_PLAIN }
297 { }
298 PROCEDURE SET_BUFFER (
299 PRINCIPAL_NAME : STRING );
300 BEGIN { PROCEDURE SET_BUFFER }
301 INPUT_IOSB.IOSB$W_BCNT :=
302 MIN ( SIZE ( PRINCIPAL_NAME ),
303 SIZE ( INPUT_BUFFER ) );
304 { }
305 { The following line will produce a }
306 { Pascal run-time error if SYS$ACM does }
307 { not specify input lengths of at least }
308 { 12 characters. }
309 { }
310 READV ( PRINCIPAL_NAME, INPUT_BUFFER );
311 { }
312 END; { PROCEDURE SET_BUFFER }
313 { }
314 BEGIN { FUNCTION RECURSE_OVER_ITEMS }
315 { }
316 { Process any initial Input Itemset }
317 { }
318 IF MAX_SIZE <> 0
319 THEN
320 BEGIN { process Input Itemset }
321 { }
322 { First we consider non-text ACME-specific }
323 { item codes, and the only one of those we }
324 { are prepared to handle is the Fingerprint }
325 { ACME code FINGERPRINT_READIT. }
326 { }
327 IF ITEMSET_ARRAY^[EACH_ITEMSET]
328 .ACMEIS$W_ITEM_CODE.ACMEIC$V_ACME_SPECIFIC
329 AND NOT ITEMSET_ARRAY^[EACH_ITEMSET]
330 .ACMEIS$W_ITEM_CODE.ACMEIC$V_UCS
331 THEN
332 BEGIN { ACME-specific non-text input }
333 { }
334 { Comparing MY_CONTXT^.ACMECB$L_ACME_ID }
335 { .ACMEID$V_ACME_NUM field against the }
336 { (previously queried) IDs of ACMEs from }
337 { which this client expects ACME-specific}
338 { input itemsets and also comparing
339 { }
340 { ITEMSET_ARRAY^[EACH_ITEMSET] }
341 { .ACMEIS$W_ITEM_CODE.ACMEIC$W_ITEM_CODE}
342 { against the 16-bit values of expected }
343 { ACME-specific item codes, we get the }
344 { information to dispatch to handle each }
345 { of the ACME-specific message types that}
346 { this client program knows about. }
347 { }
348 { In our case, it is only the Fingerprint}
349 { ACME and only code FINGERPRINT_READIT. }
350 { }
351 ASSERT((MY_CONTXT^.ACMECB$L_ACME_ID.ACMEID$V_ACME_NUM
352 = FINGERPRINT_ACME_ID.ACMEID$V_ACME_NUM)
353 AND (ITEMSET_ARRAY^[EACH_ITEMSET]
354 .ACMEIS$W_ITEM_CODE
355 .ACMEIC$W_ITEM_CODE
356 = FINGERPRINT_READIT ),
357 'unknown ACME-specific item code');
358 { }
359 { Exchange Fingerprint Data }
360 { }
361 { This client contains little knowledge }
362 { regarding the workings of the }
363 { Fingerprint Reader. It knows to call }
364 { SYS$QIOW using the function code }
365 { IO$_READPROMPT providing the output }
366 { "prompt" data and accepting whatever }
367 { the device provides. Buffer sizes }
368 { (within the 65535 limit) and the number}
369 { of exchanges to read a fingerprint }
370 { are governed by the Fingerprint ACME, }
371 { which has knowledge of the device }
372 { characteristics. }
373 { }
374 { Perhaps the channel is open from a }
375 { previous dialogue or recursion step. }
376 { }
377 IF FINGERPRINT_READER_CHANNEL = 0
378 THEN
379 BEGIN { a channel must be assigned }
380 MY_STATUS :=
381 $ASSIGN (
382 DEVNAM := 'FPA0:',
383 CHAN := FINGERPRINT_READER_CHANNEL );
384 { }
385 { If there is no Fingerprint Reader }
386 { on this machine, the Fingerprint }
387 { ACME should have figured that out }
388 { and not requested Fingerprint }
389 { Reader data. }
390 { }
391 IF NOT ODD(MY_STATUS)
392 then
393 RETURN MY_STATUS;
394 END; { A channel must be assigned.}
395 { }
396 { Exchange Fingerprint data }
397 { }
398 MY_STATUS :=
399 $QIOW (
400 EFN := EFN$C_ENF,
401 CHAN := FINGERPRINT_READER_CHANNEL,
402 FUNC := IO$_READPROMPT,
403 IOSB := INPUT_IOSB,
404 P1 := INPUT_BUFFER,
405 P2 := SIZE(INPUT_BUFFER),
406 P5 := IADDRESS(CHAR_ARRAY_POINTER_1^),
407 P6 := CHAR_ARRAY_LENGTH_1 );
408 IF ODD(MY_STATUS)
409 THEN
410 MY_STATUS := INPUT_IOSB.IOSB$W_STATUS;
411 IF NOT ODD(MY_STATUS)
412 THEN
413 RETURN MY_STATUS;
414 { }
415 END { ACME-specific non-text input }
416 ELSE
417 BEGIN { general or text input itemset }
418 { }
419 { Pascal does not give us the ability }
420 { that more strongly typed languages do }
421 { to force a compile-time failure in the }
422 { case where new message types have been }
423 { added to a subsequent release of VMS, }
424 { so we make these run-time checks. }
425 { }
426 ASSERT(ACMEMC$K_MIN_GEN_MSG
427 = ACMEMC$K_GENERAL,
428 'ACMEMC$K_MIN_GEN_MSG has shifted');
429 ASSERT(ACMEMC$K_MAX_GEN_MSG
430 = ACMEMC$K_DIALOGUE_ALERT,
431 'ACMEMC$K_MAX_GEN_MSG has shifted');
432 ASSERT(ACMEMC$K_MIN_LOGON_MSG
433 = ACMEMC$K_SYSTEM_IDENTIFICATION,
434 'ACMEMC$K_MIN_LOGON_MSG has shifted');
435 ASSERT(ACMEMC$K_MAX_LOGON_MSG
436 = ACMEMC$K_MAIL_NOTICES,
437 'ACMEMC$K_MAX_LOGON_MSG has shifted');
438 { }
439 { The only general item codes we know of }
440 { for input itemsets are those that are }
441 { "well known items", and those all }
442 { carry text. To be flexible for any }
443 { possible future additions, however, }
444 { we choose to handle any text input }
445 { item code, and we can detect those }
446 { by looking at bit ACMEIC$V_UCS in }
447 { the item code. That bit is simply a }
448 { predefined characteristic of the item }
449 { code and is quite independent of }
450 { whether or not a particular caller }
451 { of SYS$ACM might set the ACME$V_UCS2_4 }
452 { function modifier to indicate strings }
453 { are provided in UCS format. }
454 { }
455 IF ITEMSET_ARRAY^[EACH_ITEMSET]
456 .ACMEIS$W_ITEM_CODE.ACMEIC$V_UCS
457 THEN
458 IF ITEMSET_ARRAY^[EACH_ITEMSET]
459 .ACMEIS$W_ITEM_CODE.ACMEIC$W_ITEM_CODE
460 = ACME$_PRINCIPAL_NAME_IN
461 THEN
462 BEGIN { ACME$_PRINCIPAL_NAME_IN }
463 { }
464 { Choose a canned value. }
465 { }
466 CASE PRINCIPAL_INDEX OF
467 PRINCIPAL_1:
468 SET_BUFFER ( 'KIOSKUSER_1' );
469 PRINCIPAL_2:
470 SET_BUFFER ( 'KIOSKUSER_2' );
471 PRINCIPAL_3:
472 SET_BUFFER ( 'KIOSKUSER_3' );
473 PRINCIPAL_4:
474 SET_BUFFER ( 'KIOSKUSER_4' );
475 PRINCIPAL_5:
476 SET_BUFFER ( 'KIOSKUSER_5' );
477 PRINCIPAL_6:
478 SET_BUFFER ( 'KIOSKUSER_6' );
479 PRINCIPAL_7:
480 SET_BUFFER ( 'KIOSKUSER_7' );
481 PRINCIPAL_8:
482 SET_BUFFER ( 'KIOSKUSER_8' );
483 PRINCIPAL_9:
484 SET_BUFFER ( 'KIOSKUSER_9' );
485 PRINCIPAL_10:
486 SET_BUFFER ( 'KIOSKUSER_10' );
487 OTHERWISE
488 { }
489 { There is a bug in this program.}
490 { }
491 RETURN SS$_BUGCHECK;
492 { }
493 END; { CASE PRINCIPAL_INDEX }
494 END { ACME$_PRINCIPAL_NAME_IN }
495 ELSE
496 BEGIN { Item Code is for text }
497 { }
498 { Perhaps the channel is open }
499 { from a previous dialogue step. }
500 { }
501 IF TERMINAL_CHANNEL = 0
502 THEN
503 BEGIN { a channel must be assigned }
504 MY_STATUS :=
505 $ASSIGN (
506 DEVNAM := 'SYS$INPUT',
507 CHAN := TERMINAL_CHANNEL );
508 IF NOT ODD(MY_STATUS)
509 then
510 LIB$SIGNAL(MY_STATUS);
511 END; { a channel must be assigned }
512 { }
513 {We honor SYS$ACM specification of }
514 {Noecho, but because this client }
515 { software only has to work with }
516 { a limited number of hardware }
517 { configurations, we do not bother }
518 { to support Local Echo terminals }
519 { by masking Noecho values the way }
520 { LOGINOUT does. If we chose to }
521 { do that, we could support longer }
522 { input strings than the limit }
523 { LOGINOUT imposes because LOGINOUT }
524 { must fit the prompt and the }
525 {masking into a 255-character }
526 { maximum length imposed by RMS, }
527 { whereas we are using QIO directly. }
528 { }
529 IF ITEMSET_ARRAY^[EACH_ITEMSET]
530 .ACMEIS$L_FLAGS.ACMEDLOGFLG$V_NOECHO
531 THEN
532 QIO_FUNC := IO$_READPROMPT
533 + IO$M_NOECHO
534 ELSE
535 QIO_FUNC := IO$_READPROMPT;
536 MY_STATUS :=
537 $QIOW (
538 EFN := EFN$C_ENF,
539 CHAN := TERMINAL_CHANNEL,
540 FUNC := QIO_FUNC,
541 IOSB := INPUT_IOSB,
542 P1 := INPUT_BUFFER,
543 P2 := SIZE(INPUT_BUFFER),
544 P5 := IADDRESS(CHAR_ARRAY_POINTER_1^),
545 P6 := CHAR_ARRAY_LENGTH_1 );
546 IF ODD(MY_STATUS)
547 THEN
548 MY_STATUS := INPUT_IOSB.IOSB$W_STATUS;
549 IF NOT ODD(MY_STATUS)
550 THEN
551 RETURN MY_STATUS;
552 CONFIRM_IOSB.IOSB$W_BCNT := 0;
553 IF CHAR_ARRAY_POINTER_2 <> NIL
554 THEN
555 REPEAT
556 BEGIN { Confirmation Specified }
557 MY_STATUS :=
558 $QIOW (
559 EFN := EFN$C_ENF,
560 CHAN := TERMINAL_CHANNEL,
561 FUNC := QIO_FUNC,
562 IOSB := CONFIRM_IOSB,
563 P1 := CONFIRM_BUFFER,
564 P2 := SIZE(CONFIRM_BUFFER),
565 P5 := IADDRESS(CHAR_ARRAY_POINTER_2^),
566 P6 := CHAR_ARRAY_LENGTH_2 );
567 IF ODD(MY_STATUS)
568 THEN
569 MY_STATUS := INPUT_IOSB.IOSB$W_STATUS;
570 IF NOT ODD(MY_STATUS)
571 THEN
572 RETURN MY_STATUS;
573 END { Confirmation Specified }
574 UNTIL SUBSTR(CONFIRM_BUFFER,1,
575 CONFIRM_IOSB.IOSB$W_BCNT)
576 = SUBSTR(INPUT_BUFFER,1,
577 INPUT_IOSB.IOSB$W_BCNT);
578 END { Item Code is for text }
579 ELSE
580 { }
581 { Only ACME-specific itemsets }
582 { can have non-text item codes. }
583 { }
584 RETURN SS$_BUGCHECK;
585 { }
586 END; { general or text input itemset }
587 { }
588 { Fill in the Item List with the }
589 { input we just gathered. }
590 { }
591 { Bubble the null terminator up by 1.}
592 { }
593 ITEM_LIST[EACH_ITEM+1] :=
594 ITEM_LIST[EACH_ITEM];
595 { }
596 { Add the new entry. }
597 { }
598 ITEM_LIST[EACH_ITEM].ILE3$W_LENGTH :=
599 INPUT_IOSB.IOSB$W_BCNT;
600 ITEM_LIST[EACH_ITEM].ILE3$W_CODE::ACMEIC$TYPE :=
601 ITEMSET_ARRAY^[EACH_ITEMSET].ACMEIS$W_ITEM_CODE;
602 ITEM_LIST[EACH_ITEM].ILE3$PS_BUFADDR :=
603 IADDRESS(INPUT_BUFFER);
604 EACH_ITEM := EACH_ITEM + 1;
605 EACH_ITEMSET := EACH_ITEMSET + 1;
606 { }
607 END; { process Input Itemset }
608 { }
609 { Process Output Itemsets up to the next }
610 { Input Itemset. }
611 { }
612 WHILE EACH_ITEMSET <= ITEMSET_COUNT DO
613 BEGIN { process one itemset }
614 CHAR_ARRAY_LENGTH_1
615 := ITEMSET_ARRAY^[EACH_ITEMSET]
616 .acmeis$q_data_1
617 .L0 MOD 65536;
618 CHAR_ARRAY_POINTER_1
619 := ITEMSET_ARRAY^[EACH_ITEMSET]
620 .acmeis$q_data_1
621 .L1::CHAR_ARRAY_TYPE_POINTER;
622 CHAR_ARRAY_LENGTH_2
623 := ITEMSET_ARRAY^[EACH_ITEMSET]
624 .acmeis$q_data_2
625 .L0 MOD 65536;
626 CHAR_ARRAY_POINTER_2
627 := ITEMSET_ARRAY^[EACH_ITEMSET]
628 .acmeis$q_data_2
629 .L1::CHAR_ARRAY_TYPE_POINTER;
630 IF ITEMSET_ARRAY^[EACH_ITEMSET].ACMEIS$L_FLAGS
631 .ACMEDLOGFLG$V_INPUT
632 THEN
633 { }
634 { Recurse to provide an input buffer }
635 { for this input itemset. }
636 { }
637 RETURN RECURSE_OVER_ITEMS (
638 ITEMSET_ARRAY^[EACH_ITEMSET]
639 .ACMEIS$W_MAX_LENGTH )
640 { }
641 ELSE
642 IF ITEMSET_ARRAY^[EACH_ITEMSET].ACMEIS$W_MSG_TYPE
643 .ACMEMC$V_ACME_SPECIFIC
644 AND NOT ITEMSET_ARRAY^[EACH_ITEMSET]
645 .ACMEIS$W_ITEM_CODE.ACMEIC$V_UCS
646 THEN { ACME-specific non-text }
647 { }
648 { Comparing MY_CONTXT^.ACMECB$L_ACME_ID }
649 { .ACMEID$V_ACME_NUM field against the }
650 { (previously queried) IDs of ACMEs from }
651 { which this client expects ACME-specific}
652 { output itemsets, and also }
653 { }
654 { comparing ITEMSET_ARRAY^[EACH_ITEMSET] }
655 { .ACMEIS$W_MSG_TYPE.ACMEMC$W_MSG_CODE}
656 { against the 16-bit values of expected }
657 { ACME-specific message types, we get the}
658 { information to dispatch to handle each }
659 { of the ACME-specific message types that}
660 { this client program knows about. }
661 { }
662 { But this client does not know about any}
663 { ACME-specific message types, so an ACME}
664 { that sent a message we cannot handle is}
665 { behaving totally incorrectly, and we }
666 { give up. }
667 { }
668 ASSERT(FALSE,
669 'unknown ACME-specific message type')
670 { }
671 ELSE
672 BEGIN { text or general output itemset }
673 { }
674 { Pascal does not give us the ability }
675 { that more strongly typed languages do }
676 { to force a compile-time failure in the }
677 { case where new message types have been }
678 { added to a subsequent release of VMS, }
679 { so we make these run-time checks. }
680 { }
681 ASSERT(ACMEMC$K_MIN_GEN_MSG
682 = ACMEMC$K_GENERAL,
683 'ACMEMC$K_MIN_GEN_MSG has shifted');
684 ASSERT(ACMEMC$K_MAX_GEN_MSG
685 = ACMEMC$K_DIALOGUE_ALERT,
686 'ACMEMC$K_MAX_GEN_MSG has shifted');
687 ASSERT(ACMEMC$K_MIN_LOGON_MSG
688 = ACMEMC$K_SYSTEM_IDENTIFICATION,
689 'ACMEMC$K_MIN_LOGON_MSG has shifted');
690 ASSERT(ACMEMC$K_MAX_LOGON_MSG
691 = ACMEMC$K_MAIL_NOTICES,
692 'ACMEMC$K_MAX_LOGON_MSG has shifted');
693 { }
694 { All general output itemsets carry text,}
695 { but based on the type of item, it would}
696 { be possible to display them on various }
697 { parts of the screen with distinctive }
698 { colors and video characteristics. }
699 { }
700 { That part is left as an exercise for }
701 { the reader, and in each case we call }
702 { WRITE_ITEM_PLAIN. }
703 { }
704 CASE ITEMSET_ARRAY^[EACH_ITEMSET]
705 .ACMEIS$W_MSG_TYPE
706 .ACMEMC$W_MSG_CODE of
707 ACMEMC$K_GENERAL :
708 { General text }
709 WRITE_ITEM_PLAIN;
710 ACMEMC$K_HEADER :
711 { Header text }
712 WRITE_ITEM_PLAIN;
713 ACMEMC$K_TRAILER :
714 { Trailer text }
715 WRITE_ITEM_PLAIN;
716 ACMEMC$K_SELECTION :
717 { Acceptable choices }
718 WRITE_ITEM_PLAIN;
719 ACMEMC$K_DIALOGUE_ALERT :
720 { Alert (advisory) }
721 WRITE_ITEM_PLAIN;
722 ACMEMC$K_SYSTEM_IDENTIFICATION :
723 { System identification text }
724 WRITE_ITEM_PLAIN;
725 ACMEMC$K_SYSTEM_NOTICES :
726 { System notices }
727 WRITE_ITEM_PLAIN;
728 ACMEMC$K_WELCOME_NOTICES :
729 { Welcome notices, }
730 WRITE_ITEM_PLAIN;
731 ACMEMC$K_LOGON_NOTICES :
732 { Logon notices }
733 WRITE_ITEM_PLAIN;
734 ACMEMC$K_PASSWORD_NOTICES :
735 { Password notices }
736 WRITE_ITEM_PLAIN;
737 ACMEMC$K_MAIL_NOTICES :
738 { MAIL notices }
739 WRITE_ITEM_PLAIN;
740 otherwise
741 { }
742 { Some other output message type.}
743 { }
744 WRITE_ITEM_PLAIN;
745 { }
746 END; { CASE ACMEMC$W_MSG_CODE }
747 END; { text or general output itemset }
748 EACH_ITEMSET := EACH_ITEMSET + 1;
749 END; { process one itemset }
750 { }
751 { We have reached the end, call SYS$ACM. }
752 { }
753 RECURSE_OVER_ITEMS := $ACM (
754 EFN := EFN$C_ENF,
755 FUNC := ACME$_FC_AUTHENTICATE_PRINCIPAL,
756 ITMLST := ITEM_LIST,
757 CONTXT := %IMMED IADDRESS(MY_CONTXT),
758 ACMSB := MY_ACMESB );
759 END; { FUNCTION RECURSE_OVER_ITEMS }
760 BEGIN { FUNCTION RESPOND }
761 ITEM_LIST[EACH_ITEM].ILE3$W_LENGTH := 0;
762 ITEM_LIST[EACH_ITEM].ILE3$W_CODE := 0;
763 ITEM_LIST[EACH_ITEM].ILE3$PS_BUFADDR := 0;
764 ITEM_LIST[EACH_ITEM].ILE3$PS_RETLEN_ADDR := NIL;
765 { }
766 { We provide 0 as an indication that this is the }
767 { outermost call, rather than one made due to }
768 { encountering an input itemset. }
769 { }
770 RESPOND := RECURSE_OVER_ITEMS ( 0 );
771 { }
772 END; { FUNCTION RESPOND }
773 BEGIN { FUNCTION AUTHENTICATE }
774 { }
775 { Make an initial query to determine the ACME ID of }
776 { the Fingerprint ACME in the current running system. }
777 { }
778 ACM_QUERY_ITMLST[0].ILE3$PS_BUFADDR := IADDRESS(SYS$ACM_ACME_ID);
779 ACM_QUERY_ITMLST[1].ILE3$PS_BUFADDR := IADDRESS(ACME_QUERY_ACME_NAME);
780 ACM_QUERY_ITMLST[2].ILE3$PS_BUFADDR := IADDRESS(FINGERPRINT_ACME_NAME);
781 ACM_QUERY_ITMLST[3].ILE3$PS_BUFADDR := IADDRESS(ACME_TARGET_DOI_ID);
782 ACM_QUERY_ITMLST[4].ILE3$PS_BUFADDR := IADDRESS(FINGERPRINT_ACME_ID);
783 MY_STATUS:=1;
784 MY_ACMESB.ACMESB$L_STATUS := ACME$_NOSUCHDOI;
785 IF not ODD(MY_STATUS) then
786 MY_STATUS := $ACMW (
787 EFN := EFN$C_ENF,
788 FUNC := ACME$_FC_QUERY,
789 ITMLST := ACM_QUERY_ITMLST,
790 ACMSB := MY_ACMESB );
791 IF ODD(MY_STATUS)
792 then
793 MY_STATUS := MY_ACMESB.ACMESB$L_STATUS;
794 IF NOT ODD(MY_STATUS)
795 then
796 { }
797 { "No Fingerprint ACME present" is a perfectly valid }
798 { state of affairs, and we record a zero ACME ID. }
799 { }
800 IF MY_STATUS = ACME$_NOSUCHDOI
801 THEN
802 FINGERPRINT_ACME_ID := ZERO
803 ELSE
804 LIB$SIGNAL(MY_STATUS);
805 { }
806 { Make an initial authentication call. }
807 { }
808 MY_CONTXT := (-1)::ACMECB_PTR;
809 MY_ACM_ITMLST_A[0].ILE3$PS_BUFADDR := IADDRESS(MY_LOGON_TYPE);
810 MY_ACM_ITMLST_A[1].ILE3$PS_BUFADDR := IADDRESS(MY_DIALOGUE_SUPPORT);
811 MY_STATUS := $ACMW (
812 EFN := EFN$C_ENF,
813 FUNC := ACME$_FC_AUTHENTICATE_PRINCIPAL,
814 ITMLST := MY_ACM_ITMLST_A,
815 CONTXT := %IMMED IADDRESS(MY_CONTXT),
816 ACMSB := MY_ACMESB );
817 IF ODD(MY_STATUS)
818 then
819 MY_STATUS := MY_ACMESB.ACMESB$L_STATUS;
820 IF NOT ODD(MY_STATUS)
821 then
822 { }
823 { "Operation Incomplete" is to be expected. }
824 { }
825 IF MY_STATUS <> ACME$_OPINCOMPL
826 THEN
827 LIB$SIGNAL(MY_STATUS);
828 { }
829 { Respond to successive dialogue steps. }
830 { }
831 WHILE MY_STATUS = ACME$_OPINCOMPL DO
832 BEGIN
833 ITEMSET_ARRAY := MY_CONTXT^
834 .acmecb$ps_item_set::ITEMSET_ARRAY_TYPE_POINTER;
835 MY_STATUS
836 := RESPOND ( MY_CONTXT^.acmecb$l_item_set_count );
837 IF NOT ODD(MY_STATUS)
838 then
839 BEGIN { Abandon the authentication }
840 MY_ACM_ITMLST_A[0].ILE3$W_LENGTH := 0;
841 MY_ACM_ITMLST_A[0].ILE3$W_CODE := 0;
842 MY_ACM_ITMLST_A[0].ILE3$PS_BUFADDR := 0;
843 MY_ACM_ITMLST_A[0].ILE3$PS_RETLEN_ADDR := NIL;
844 TRASH_STATUS := $ACMW (
845 EFN := EFN$C_ENF,
846 FUNC := ACME$_FC_FREE_CONTEXT,
847 ITMLST := MY_ACM_ITMLST_A,
848 CONTXT := %IMMED IADDRESS(MY_CONTXT),
849 ACMSB := MY_ACMESB );
850 LIB$SIGNAL(MY_STATUS);
851 END; { Abandon the authentication }
852 MY_STATUS := $SYNCH_ACMESB (
853 EFN := EFN$C_ENF,
854 IOSB := MY_ACMESB );
855 IF ODD(MY_STATUS)
856 then
857 MY_STATUS := MY_ACMESB.ACMESB$L_STATUS;
858 END;
859 IF NOT ODD(MY_STATUS)
860 then
861 LIB$SIGNAL(MY_STATUS);
862 { }
863 IF FINGERPRINT_READER_CHANNEL <> 0
864 THEN
865 BEGIN { a channel was assigned }
866 MY_STATUS :=
867 $DASSGN (
868 CHAN := FINGERPRINT_READER_CHANNEL );
869 IF NOT ODD(MY_STATUS)
870 then
871 LIB$SIGNAL(MY_STATUS);
872 END; { a channel was assigned }
873 { }
874 IF TERMINAL_CHANNEL <> 0
875 THEN
876 BEGIN { a channel was assigned }
877 MY_STATUS :=
878 $DASSGN (
879 CHAN := TERMINAL_CHANNEL );
880 IF NOT ODD(MY_STATUS)
881 then
882 LIB$SIGNAL(MY_STATUS);
883 END; { a channel was assigned }
884 { }
885 AUTHENTICATE := TRUE;
886 END; { FUNCTION AUTHENTICATE }
887 BEGIN { PROGRAM ACM_SHOPFLOOR }
888 AUTHENTICATE ( PRINCIPAL_10 );
889 END. { PROGRAM ACM_SHOPFLOOR }
|
|
