[0001]
[0002]
[0003]
[0004]
[0005]
[0006]
[0007]
[0008]
[0009]
[0010]
[0011]
[0012]
[0013]
[0014]
[0015]
[0016]
[0017]
[0018]
[0019]
[0020]
[0021]
[0022]
[0023]
[0024]
[0025]
[0026]
[0027]
[0028]
[0029]
[0030]
[0031]
[0032]
[0033]
[0034]
[0035]
[0036]
[0037]
[0038]
[0039]
[0040]
[0041]
[0042]
[0043]
[0044]
[0045]
[0046]
[0047]
[0048]
[0049]
[0050]
[0051]
[0052]
[0053]
[0054]
[0055]
[0056]
[0057]
[0058]
[0059]
[0060]
[0061]
[0062]
[0063]
[0064]
[0065]
[0066]
[0067]
[0068]
[0069]
[0070]
[0071]
[0072]
[0073]
[0074]
[0075]
[0076]
[0077]
[0078]
[0079]
[0080]
[0081]
[0082]
[0083]
[0084]
[0085]
[0086]
[0087]
[0088]
[0089]
[0090]
[0091]
[0092]
[0093]
[0094]
[0095]
[0096]
[0097]
[0098]
[0099]
[0100]
[0101]
[0102]
[0103]
[0104]
[0105]
[0106]
[0107]
[0108]
[0109]
[0110]
[0111]
[0112]
[0113]
[0114]
[0115]
[0116]
[0117]
[0118]
[0119]
[0120]
[0121]
[0122]
[0123]
[0124]
[0125]
[0126]
[0127]
[0128]
[0129]
[0130]
[0131]
[0132]
[0133]
[0134]
[0135]
[0136]
[0137]
[0138]
[0139]
[0140]
[0141]
[0142]
[0143]
[0144]
[0145]
[0146]
[0147]
[0148]
[0149]
[0150]
[0151]
[0152]
[0153]
[0154]
[0155]
[0156]
[0157]
[0158]
[0159]
[0160]
[0161]
[0162]
[0163]
[0164]
[0165]
[0166]
[0167]
[0168]
[0169]
[0170]
[0171]
[0172]
[0173]
[0174]
[0175]
[0176]
[0177]
[0178]
[0179]
[0180]
[0181]
[0182]
[0183]
[0184]
[0185]
[0186]
[0187]
[0188]
[0189]
[0190]
[0191]
[0192]
[0193]
[0194]
[0195]
[0196]
[0197]
[0198]
[0199]
[0200]
[0201]
[0202]
[0203]
[0204]
[0205]
[0206]
[0207]
[0208]
[0209]
[0210]
[0211]
[0212]
[0213]
[0214]
[0215]
[0216]
[0217]
[0218]
[0219]
[0220]
[0221]
[0222]
[0223]
[0224]
[0225]
[0226]
[0227]
[0228]
[0229]
[0230]
[0231]
[0232]
[0233]
[0234]
[0235]
[0236]
[0237]
[0238]
[0239]
[0240]
[0241]
[0242]
[0243]
[0244]
[0245]
[0246]
[0247]
[0248]
[0249]
[0250]
[0251]
[0252]
[0253]
[0254]
[0255]
[0256]
[0257]
[0258]
[0259]
[0260]
[0261]
[0262]
[0263]
[0264]
[0265]
[0266]
[0267]
[0268]
[0269]
[0270]
[0271]
[0272]
[0273]
[0274]
[0275]
[0276]
[0277]
[0278]
[0279]
[0280]
[0281]
[0282]
[0283]
[0284]
[0285]
[0286]
[0287]
[0288]
[0289]
[0290]
[0291]
[0292]
[0293]
[0294]
[0295]
[0296]
[0297]
[0298]
[0299]
[0300]
[0301]
[0302]
[0303]
[0304]
[0305]
[0306]
[0307]
[0308]
[0309]
[0310]
[0311]
[0312]
[0313]
[0314]
[0315]
[0316]
[0317]
[0318]
[0319]
[0320]
[0321]
[0322]
[0323]
[0324]
[0325]
[0326]
[0327]
[0328]
[0329]
[0330]
[0331]
[0332]
[0333]
[0334]
[0335]
[0336]
[0337]
[0338]
[0339]
[0340]
[0341]
[0342]
[0343]
[0344]
[0345]
[0346]
[0347]
[0348]
[0349]
[0350]
[0351]
[0352]
[0353]
[0354]
[0355]
[0356]
[0357]
[0358]
[0359]
[0360]
[0361]
[0362]
[0363]
[0364]
[0365]
[0366]
[0367]
[0368]
[0369]
[0370]
[0371]
[0372]
[0373]
[0374]
[0375]
[0376]
[0377]
[0378]
[0379]
[0380]
[0381]
[0382]
[0383]
[0384]
[0385]
[0386]
[0387]
[0388]
[0389]
[0390]
[0391]
[0392]
[0393]
[0394]
[0395]
[0396]
[0397]
[0398]
[0399]
[0400]
[0401]
[0402]
[0403]
[0404]
[0405]
[0406]
[0407]
[0408]
[0409]
[0410]
[0411]
[0412]
[0413]
[0414]
[0415]
[0416]
[0417]
[0418]
[0419]
[0420]
[0421]
[0422]
[0423]
[0424]
[0425]
[0426]
[0427]
[0428]
[0429]
[0430]
[0431]
[0432]
[0433]
[0434]
[0435]
[0436]
[0437]
[0438]
[0439]
[0440]
[0441]
[0442]
[0443]
[0444]
[0445]
[0446]
[0447]
[0448]
[0449]
[0450]
[0451]
[0452]
[0453]
[0454]
[0455]
[0456]
[0457]
[0458]
[0459]
[0460]
[0461]
[0462]
[0463]
[0464]
[0465]
[0466]
[0467]
[0468]
[0469]
[0470]
[0471]
[0472]
[0473]
[0474]
[0475]
[0476]
[0477]
[0478]
[0479]
[0480]
[0481]
[0482]
[0483]
[0484]
[0485]
[0486]
[0487]
[0488]
[0489]
[0490]
[0491]
[0492]
[0493]
[0494]
[0495]
[0496]
[0497]
[0498]
[0499]
[0500]
[0501]
[0502]
[0503]
[0504]
[0505]
[0506]
[0507]
[0508]
[0509]
[0510]
[0511]
[0512]
[0513]
[0514]
[0515]
[0516]
[0517]
[0518]
[0519]
[0520]
[0521]
[0522]
[0523]
[0524]
[0525]
[0526]
[0527]
[0528]
[0529]
[0530]
[0531]
[0532]
[0533]
[0534]
[0535]
[0536]
[0537]
[0538]
[0539]
[0540]
[0541]
[0542]
[0543]
[0544]
[0545]
[0546]
[0547]
[0548]
[0549]
[0550]
[0551]
[0552]
[0553]
[0554]
[0555]
[0556]
[0557]
[0558]
[0559]
[0560]
[0561]
[0562]
[0563]
[0564]
[0565]
[0566]
[0567]
[0568]
[0569]
[0570]
[0571]
[0572]
[0573]
[0574]
[0575]
[0576]
[0577]
[0578]
[0579]
[0580]
[0581]
[0582]
[0583]
[0584]
[0585]
[0586]
[0587]
[0588]
[0589]
[0590]
[0591]
[0592]
[0593]
[0594]
[0595]
[0596]
[0597]
[0598]
[0599]
[0600]
[0601]
[0602]
[0603]
[0604]
[0605]
[0606]
[0607]
[0608]
[0609]
[0610]
[0611]
[0612]
[0613]
[0614]
[0615]
[0616]
[0617]
[0618]
[0619]
[0620]
[0621]
[0622]
[0623]
[0624]
[0625]
[0626]
[0627]
[0628]
[0629]
[0630]
[0631]
[0632]
[0633]
[0634]
[0635]
[0636]
[0637]
[0638]
[0639]
[0640]
[0641]
[0642]
[0643]
[0644]
[0645]
[0646]
[0647]
[0648]
[0649]
[0650]
[0651]
[0652]
[0653]
[0654]
[0655]
[0656]
[0657]
[0658]
[0659]
[0660]
[0661]
[0662]
[0663]
[0664]
[0665]
[0666]
[0667]
[0668]
[0669]
[0670]
[0671]
[0672]
[0673]
[0674]
[0675]
[0676]
[0677]
[0678]
[0679]
[0680]
[0681]
[0682]
[0683]
[0684]
[0685]
[0686]
[0687]
[0688]
[0689]
[0690]
[0691]
[0692]
[0693]
[0694]
[0695]
[0696]
[0697]
[0698]
[0699]
[0700]
[0701]
[0702]
[0703]
[0704]
[0705]
[0706]
[0707]
[0708]
[0709]
[0710]
[0711]
[0712]
[0713]
[0714]
[0715]
[0716]
[0717]
[0718]
[0719]
[0720]
[0721]
[0722]
[0723]
[0724]
[0725]
[0726]
[0727]
[0728]
[0729]
[0730]
[0731]
[0732]
[0733]
[0734]
[0735]
[0736]
[0737]
[0738]
[0739]
[0740]
[0741]
[0742]
[0743]
[0744]
[0745]
[0746]
[0747]
[0748]
[0749]
[0750]
[0751]
[0752]
[0753]
[0754]
[0755]
[0756]
[0757]
[0758]
[0759]
[0760]
[0761]
[0762]
[0763]
[0764]
[0765]
[0766]
[0767]
[0768]
[0769]
[0770]
[0771]
[0772]
[0773]
[0774]
[0775]
[0776]
[0777]
[0778]
[0779]
[0780]
[0781]
[0782]
[0783]
[0784]
[0785]
[0786]
[0787]
[0788]
[0789]
[0790]
[0791]
[0792]
[0793]
[0794]
[0795]
[0796]
[0797]
[0798]
[0799]
[0800]
[0801]
[0802]
[0803]
[0804]
[0805]
[0806]
[0807]
[0808]
[0809]
[0810]
[0811]
[0812]
[0813]
[0814]
[0815]
[0816]
[0817]
[0818]
[0819]
[0820]
[0821]
[0822]
[0823]
[0824]
[0825]
[0826]
[0827]
[0828]
[0829]
[0830]
[0831]
[0832]
[0833]
[0834]
[0835]
[0836]
[0837]
[0838]
[0839]
[0840]
[0841]
[0842]
[0843]
[0844]
[0845]
[0846]
[0847]
[0848]
[0849]
[0850]
[0851]
[0852]
[0853]
[0854]
[0855]
[0856]
[0857]
[0858]
[0859]
[0860]
[0861]
[0862]
[0863]
[0864]
[0865]
[0866]
[0867]
[0868]
[0869]
[0870]
[0871]
[0872]
[0873]
[0874]
[0875]
[0876]
[0877]
[0878]
[0879]
[0880]
[0881]
[0882]
[0883]
[0884]
[0885]
[0886]
[0887]
[0888]
[0889]
[0890]
[0891]
[0892]
[0893]
[0894]
[0895]
[0896]
[0897]
[0898]
[0899]
[0900]
[0901]
[0902]
[0903]
[0904]
[0905]
[0906]
[0907]
[0908]
[0909]
[0910]
[0911]
[0912]
[0913]
[0914]
[0915]
[0916]
[0917]
[0918]
[0919]
[0920]
[0921]
[0922]
[0923]
[0924]
[0925]
[0926]
[0927]
[0928]
[0929]
[0930]
[0931]
[0932]
[0933]
[0934]
[0935]
[0936]
[0937]
[0938]
[0939]
[0940]
[0941]
[0942]
[0943]
[0944]
[0945]
[0946]
[0947]
[0948]
[0949]
[0950]
[0951]
[0952]
[0953]
[0954]
[0955]
[0956]
[0957]
[0958]
[0959]
[0960]
[0961]
[0962]
[0963]
[0964]
[0965]
[0966]
[0967]
[0968]
[0969]
[0970]
[0971]
[0972]
[0973]
[0974]
[0975]
[0976]
[0977]
[0978]
[0979]
[0980]
[0981]
[0982]
[0983]
[0984]
[0985]
[0986]
[0987]
[0988]
[0989]
[0990]
[0991]
[0992]
[0993]
[0994]
[0995]
[0996]
[0997]
[0998]
[0999]
[1000]
[1001]
[1002]
[1003]
[1004]
[1005]
[1006]
[1007]
[1008]
[1009]
[1010]
[1011]
[1012]
[1013]
[1014]
[1015]
[1016]
[1017]
[1018]
[1019]
[1020]
[1021]
[1022]
[1023]
[1024]
[1025]
[1026]
[1027]
[1028]
[1029]
[1030]
[1031]
[1032]
[1033]
[1034]
[1035]
[1036]
[1037]
[1038]
[1039]
[1040]
[1041]
[1042]
[1043]
[1044]
[1045]
[1046]
[1047]
[1048]
[1049]
[1050]
[1051]
[1052]
[1053]
[1054]
[1055]
[1056]
[1057]
[1058]
[1059]
[1060]
[1061]
[1062]
[1063]
[1064]
[1065]
[1066]
[1067]
[1068]
[1069]
[1070]
[1071]
[1072]
[1073]
[1074]
[1075]
[1076]
[1077]
[1078]
[1079]
[1080]
[1081]
[1082]
[1083]
[1084]
[1085]
[1086]
[1087]
[1088]
[1089]
[1090]
[1091]
[1092]
[1093]
[1094]
[1095]
[1096]
[1097]
[1098]
[1099]
[1100]
[1101]
[1102]
[1103]
[1104]
[1105]
[1106]
[1107]
[1108]
[1109]
[1110]
[1111]
[1112]
[1113]
[1114]
[1115]
[1116]
[1117]
[1118]
[1119]
[1120]
[1121]
[1122]
[1123]
[1124]
[1125]
[1126]
[1127]
[1128]
[1129]
[1130]
[1131]
[1132]
[1133]
[1134]
[1135]
[1136]
[1137]
[1138]
[1139]
[1140]
[1141]
[1142]
[1143]
[1144]
[1145]
[1146]
[1147]
[1148]
[1149]
[1150]
[1151]
[1152]
[1153]
[1154]
[1155]
[1156]
[1157]
[1158]
[1159]
[1160]
[1161]
[1162]
[1163]
[1164]
[1165]
[1166]
[1167]
[1168]
[1169]
[1170]
[1171]
[1172]
[1173]
[1174]
[1175]
[1176]
[1177]
[1178]
[1179]
[1180]
[1181]
[1182]
[1183]
[1184]
[1185]
[1186]
[1187]
[1188]
[1189]
[1190]
[1191]
[1192]
[1193]
[1194]
[1195]
[1196]
[1197]
[1198]
[1199]
[1200]
[1201]
[1202]
[1203]
[1204]
[1205]
[1206]
[1207]
[1208]
[1209]
[1210]
[1211]
[1212]
[1213]
[1214]
[1215]
[1216]
[1217]
[1218]
[1219]
[1220]
[1221]
[1222]
[1223]
[1224]
[1225]
[1226]
[1227]
[1228]
[1229]
[1230]
[1231]
[1232]
[1233]
[1234]
[1235]
[1236]
[1237]
[1238]
[1239]
[1240]
[1241]
[1242]
[1243]
[1244]
[1245]
[1246]
[1247]
[1248]
[1249]
[1250]
[1251]
[1252]
[1253]
[1254]
[1255]
[1256]
[1257]
[1258]
[1259]
[1260]
[1261]
[1262]
[1263]
[1264]
[1265]
[1266]
[1267]
[1268]
[1269]
[1270]
[1271]
[1272]
[1273]
[1274]
[1275]
[1276]
[1277]
[1278]
[1279]
[1280]
[1281]
[1282]
[1283]
[1284]
[1285]
[1286]
[1287]
[1288]
[1289]
[1290]
[1291]
[1292]
[1293]
[1294]
[1295]
[1296]
[1297]
[1298]
[1299]
[1300]
[1301]
[1302]
[1303]
[1304]
[1305]
[1306]
[1307]
[1308]
[1309]
[1310]
[1311]
[1312]
[1313]
[1314]
[1315]
[1316]
[1317]
[1318]
[1319]
[1320]
[1321]
[1322]
[1323]
[1324]
[1325]
[1326]
[1327]
[1328]
[1329]
[1330]
[1331]
[1332]
[1333]
[1334]
[1335]
[1336]
[1337]
[1338]
[1339]
[1340]
[1341]
[1342]
[1343]
[1344]
[1345]
[1346]
[1347]
[1348]
[1349]
[1350]
[1351]
[1352]
[1353]
[1354]
[1355]
[1356]
[1357]
[1358]
[1359]
[1360]
[1361]
[1362]
[1363]
[1364]
[1365]
[1366]
[1367]
[1368]
[1369]
[1370]
[1371]
[1372]
[1373]
[1374]
[1375]
[1376]
[1377]
[1378]
[1379]
[1380]
[1381]
[1382]
[1383]
[1384]
[1385]
[1386]
[1387]
[1388]
[1389]
[1390]
[1391]
[1392]
[1393]
[1394]
[1395]
[1396]
[1397]
[1398]
[1399]
[1400]
[1401]
[1402]
[1403]
[1404]
[1405]
[1406]
[1407]
[1408]
[1409]
[1410]
[1411]
[1412]
[1413]
[1414]
[1415]
[1416]
[1417]
[1418]
[1419]
[1420]
[1421]
[1422]
[1423]
[1424]
[1425]
[1426]
[1427]
[1428]
[1429]
[1430]
[1431]
[1432]
[1433]
[1434]
[1435]
[1436]
[1437]
[1438]
[1439]
[1440]
[1441]
[1442]
[1443]
[1444]
[1445]
[1446]
[1447]
[1448]
[1449]
[1450]
[1451]
[1452]
[1453]
[1454]
[1455]
[1456]
[1457]
[1458]
[1459]
[1460]
[1461]
[1462]
[1463]
[1464]
[1465]
[1466]
[1467]
[1468]
[1469]
[1470]
[1471]
[1472]
[1473]
[1474]
[1475]
[1476]
[1477]
[1478]
[1479]
[1480]
[1481]
[1482]
[1483]
[1484]
[1485]
[1486]
[1487]
[1488]
[1489]
[1490]
[1491]
[1492]
[1493]
[1494]
[1495]
[1496]
[1497]
[1498]
[1499]
[1500]
[1501]
[1502]
[1503]
[1504]
[1505]
[1506]
[1507]
[1508]
[1509]
[1510]
[1511]
[1512]
[1513]
[1514]
[1515]
[1516]
[1517]
[1518]
[1519]
[1520]
[1521]
[1522]
[1523]
[1524]
[1525]
[1526]
[1527]
[1528]
[1529]
[1530]
[1531]
[1532]
[1533]
[1534]
[1535]
[1536]
[1537]
[1538]
[1539]
[1540]
[1541]
[1542]
[1543]
[1544]
[1545]
[1546]
[1547]
[1548]
[1549]
[1550]
[1551]
[1552]
[1553]
[1554]
[1555]
[1556]
[1557]
[1558]
[1559]
[1560]
[1561]
[1562]
[1563]
[1564]
[1565]
[1566]
[1567]
[1568]
[1569]
[1570]
[1571]
[1572]
[1573]
[1574]
[1575]
[1576]
[1577]
[1578]
[1579]
[1580]
[1581]
[1582]
[1583]
[1584]
[1585]
[1586]
[1587]
[1588]
[1589]
[1590]
[1591]
[1592]
[1593]
[1594]
[1595]
[1596]
[1597]
[1598]
[1599]
[1600]
[1601]
[1602]
[1603]
[1604]
[1605]
[1606]
[1607]
[1608]
[1609]
[1610]
[1611]
[1612]
[1613]
[1614]
[1615]
[1616]
[1617]
[1618]
[1619]
[1620]
[1621]
[1622]
[1623]
[1624]
[1625]
[1626]
[1627]
[1628]
[1629]
[1630]
[1631]
[1632]
[1633]
[1634]
[1635]
[1636]
[1637]
[1638]
[1639]
[1640]
[1641]
[1642]
[1643]
[1644]
[1645]
[1646]
[1647]
[1648]
[1649]
[1650]
[1651]
[1652]
[1653]
[1654]
[1655]
[1656]
[1657]
[1658]
[1659]
[1660]
[1661]
[1662]
[1663]
[1664]
[1665]
[1666]
[1667]
[1668]
[1669]
[1670]
[1671]
[1672]
[1673]
[1674]
[1675]
[1676]
[1677]
[1678]
[1679]
[1680]
[1681]
[1682]
[1683]
[1684]
[1685]
[1686]
[1687]
[1688]
[1689]
[1690]
[1691]
[1692]
[1693]
[1694]
[1695]
[1696]
[1697]
[1698]
[1699]
[1700]
[1701]
[1702]
[1703]
[1704]
[1705]
[1706]
[1707]
[1708]
[1709]
[1710]
[1711]
[1712]
[1713]
[1714]
[1715]
[1716]
[1717]
[1718]
[1719]
[1720]
[1721]
[1722]
[1723]
[1724]
[1725]
[1726]
[1727]
[1728]
[1729]
[1730]
[1731]
[1732]
[1733]
[1734]
[1735]
[1736]
[1737]
[1738]
[1739]
[1740]
[1741]
[1742]
[1743]
[1744]
[1745]
[1746]
[1747]
[1748]
[1749]
[1750]
[1751]
[1752]
[1753]
[1754]
[1755]
[1756]
[1757]
[1758]
[1759]
[1760]
[1761]
[1762]
[1763]
[1764]
[1765]
[1766]
[1767]
[1768]
[1769]
[1770]
[1771]
[1772]
[1773]
[1774]
[1775]
[1776]
[1777]
[1778]
[1779]
[1780]
[1781]
[1782]
[1783]
[1784]
[1785]
[1786]
[1787]
[1788]
[1789]
[1790]
[1791]
[1792]
[1793]
[1794]
[1795]
[1796]
[1797]
[1798]
[1799]
[1800]
[1801]
[1802]
[1803]
[1804]
[1805]
[1806]
[1807]
[1808]
[1809]
[1810]
[1811]
[1812]
[1813]
[1814]
[1815]
[1816]
[1817]
[1818]
[1819]
[1820]
[1821]
[1822]
[1823]
[1824]
[1825]
[1826]
[1827]
[1828]
[1829]
[1830]
[1831]
[1832]
[1833]
[1834]
[1835]
[1836]
[1837]
[1838]
[1839]
[1840]
[1841]
[1842]
[1843]
[1844]
[1845]
[1846]
[1847]
[1848]
[1849]
[1850]
[1851]
[1852]
[1853]
[1854]
[1855]
[1856]
[1857]
[1858]
[1859]
[1860]
[1861]
[1862]
[1863]
[1864]
[1865]
[1866]
[1867]
[1868]
[1869]
[1870]
[1871]
[1872]
[1873]
[1874]
[1875]
[1876]
[1877]
[1878]
[1879]
[1880]
[1881]
[1882]
[1883]
[1884]
[1885]
[1886]
[1887]
[1888]
[1889]
[1890]
[1891]
[1892]
[1893]
[1894]
[1895]
[1896]
[1897]
[1898]
[1899]
[1900]
[1901]
[1902]
[1903]
[1904]
[1905]
[1906]
[1907]
[1908]
[1909]
[1910]
[1911]
[1912]
[1913]
[1914]
[1915]
[1916]
[1917]
[1918]
[1919]
[1920]
[1921]
[1922]
[1923]
[1924]
[1925]
[1926]
[1927]
[1928]
[1929]
[1930]
[1931]
[1932]
[1933]
[1934]
[1935]
[1936]
[1937]
[1938]
[1939]
[1940]
[1941]
[1942]
[1943]
[1944]
[1945]
[1946]
[1947]
[1948]
[1949]
[1950]
[1951]
[1952]
[1953]
[1954]
[1955]
[1956]
[1957]
[1958]
[1959]
[1960]
[1961]
[1962]
[1963]
[1964]
[1965]
[1966]
[1967]
[1968]
[1969]
[1970]
[1971]
[1972]
[1973]
[1974]
[1975]
[1976]
[1977]
[1978]
[1979]
[1980]
[1981]
[1982]
[1983]
[1984]
[1985]
[1986]
[1987]
[1988]
[1989]
[1990]
[1991]
[1992]
[1993]
[1994]
[1995]
[1996]
[1997]
[1998]
[1999]
[2000]
[2001]
[2002]
[2003]
[2004]
[2005]
[2006]
[2007]
[2008]
[2009]
[2010]
[2011]
[2012]
[2013]
[2014]
[2015]
[2016]
[2017]
[2018]
[2019]
[2020]
[2021]
[2022]
[2023]
[2024]
[2025]
[2026]
[2027]
[2028]
[2029]
[2030]
[2031]
[2032]
[2033]
[2034]
[2035]
[2036]
[2037]
[2038]
[2039]
[2040]
[2041]
[2042]
[2043]
[2044]
[2045]
[2046]
[2047]
[2048]
[2049]
[2050]
[2051]
[2052]
[2053]
[2054]
[2055]
[2056]
[2057]
[2058]
[2059]
[2060]
[2061]
[2062]
[2063]
[2064]
[2065]
[2066]
[2067]
[2068]
[2069]
[2070]
[2071]
[2072]
[2073]
[2074]
[2075]
[2076]
[2077]
[2078]
[2079]
[2080]
[2081]
[2082]
[2083]
[2084]
[2085]
[2086]
[2087]
[2088]
[2089]
[2090]
[2091]
[2092]
[2093]
[2094]
[2095]
[2096]
[2097]
[2098]
[2099]
[2100]
[2101]
[2102]
[2103]
[2104]
[2105]
[2106]
[2107]
[2108]
[2109]
[2110]
[2111]
[2112]
[2113]
[2114]
[2115]
[2116]
[2117]
[2118]
[2119]
[2120]
[2121]
[2122]
[2123]
[2124]
[2125]
[2126]
[2127]
[2128]
[2129]
[2130]
[2131]
[2132]
[2133]
[2134]
[2135]
[2136]
[2137]
[2138]
[2139]
[2140]
[2141]
[2142]
[2143]
[2144]
[2145]
[2146]
[2147]
[2148]
[2149]
[2150]
[2151]
[2152]
[2153]
[2154]
[2155]
[2156]
[2157]
[2158]
[2159]
[2160]
[2161]
[2162]
[2163]
[2164]
[2165]
[2166]
[2167]
[2168]
[2169]
[2170]
[2171]
[2172]
[2173]
[2174]
[2175]
[2176]
[2177]
[2178]
[2179]
[2180]
[2181]
[2182]
[2183]
[2184]
[2185]
[2186]
[2187]
[2188]
[2189]
[2190]
[2191]
[2192]
[2193]
[2194]
[2195]
[2196]
[2197]
[2198]
[2199]
[2200]
[2201]
[2202]
[2203]
[2204]
[2205]
[2206]
[2207]
[2208]
[2209]
[2210]
[2211]
[2212]
[2213]
[2214]
[2215]
[2216]
[2217]
[2218]
[2219]
[2220]
[2221]
[2222]
[2223]
[2224]
[2225]
[2226]
[2227]
[2228]
[2229]
[2230]
[2231]
[2232]
[2233]
[2234]
[2235]
[2236]
[2237]
[2238]
[2239]
[2240]
[2241]
[2242]
[2243]
[2244]
[2245]
[2246]
[2247]
[2248]
[2249]
[2250]
[2251]
[2252]
[2253]
[2254]
[2255]
[2256]
[2257]
[2258]
[2259]
[2260]
[2261]
[2262]
[2263]
[2264]
[2265]
[2266]
[2267]
[2268]
[2269]
[2270]
[2271]
[2272]
[2273]
[2274]
[2275]
[2276]
[2277]
[2278]
[2279]
[2280]
[2281]
[2282]
[2283]
[2284]
[2285]
[2286]
[2287]
[2288]
[2289]
[2290]
[2291]
[2292]
[2293]
[2294]
[2295]
[2296]
[2297]
[2298]
[2299]
[2300]
[2301]
[2302]
[2303]
[2304]
[2305]
[2306]
[2307]
[2308]
[2309]
[2310]
[2311]
[2312]
[2313]
[2314]
[2315]
[2316]
[2317]
[2318]
[2319]
[2320]
[2321]
[2322]
[2323]
[2324]
[2325]
[2326]
[2327]
[2328]
[2329]
[2330]
[2331]
[2332]
[2333]
[2334]
[2335]
[2336]
[2337]
[2338]
[2339]
[2340]
[2341]
[2342]
[2343]
[2344]
[2345]
[2346]
[2347]
[2348]
[2349]
[2350]
[2351]
[2352]
[2353]
[2354]
[2355]
[2356]
[2357]
[2358]
[2359]
[2360]
[2361]
[2362]
[2363]
[2364]
[2365]
[2366]
[2367]
[2368]
[2369]
[2370]
[2371]
[2372]
[2373]
[2374]
[2375]
[2376]
[2377]
[2378]
[2379]
[2380]
[2381]
[2382]
[2383]
[2384]
[2385]
[2386]
[2387]
[2388]
[2389]
[2390]
[2391]
[2392]
[2393]
[2394]
[2395]
[2396]
[2397]
[2398]
[2399]
[2400]
[2401]
[2402]
[2403]
[2404]
[2405]
[2406]
[2407]
[2408]
[2409]
[2410]
[2411]
[2412]
[2413]
[2414]
[2415]
[2416]
[2417]
[2418]
[2419]
[2420]
[2421]
[2422]
[2423]
[2424]
[2425]
[2426]
[2427]
[2428]
[2429]
[2430]
[2431]
[2432]
[2433]
[2434]
[2435]
[2436]
[2437]
[2438]
[2439]
[2440]
[2441]
[2442]
[2443]
[2444]
[2445]
[2446]
[2447]
[2448]
[2449]
[2450]
[2451]
[2452]
[2453]
[2454]
[2455]
[2456]
[2457]
[2458]
[2459]
[2460]
[2461]
[2462]
[2463]
[2464]
[2465]
[2466]
[2467]
[2468]
[2469]
[2470]
[2471]
[2472]
[2473]
[2474]
[2475]
[2476]
[2477]
[2478]
[2479]
[2480]
[2481]
[2482]
[2483]
[2484]
[2485]
[2486]
[2487]
[2488]
[2489]
[2490]
[2491]
[2492]
[2493]
[2494]
[2495]
[2496]
[2497]
[2498]
[2499]
[2500]
[2501]
[2502]
[2503]
[2504]
[2505]
[2506]
[2507]
[2508]
[2509]
[2510]
[2511]
[2512]
[2513]
[2514]
[2515]
[2516]
[2517]
[2518]
[2519]
[2520]
[2521]
[2522]
[2523]
[2524]
[2525]
[2526]
[2527]
[2528]
[2529]
[2530]
[2531]
[2532]
[2533]
[2534]
[2535]
[2536]
[2537]
[2538]
[2539]
[2540]
[2541]
[2542]
[2543]
[2544]
[2545]
[2546]
[2547]
[2548]
[2549]
[2550]
[2551]
[2552]
[2553]
[2554]
[2555]
[2556]
[2557]
[2558]
[2559]
[2560]
[2561]
[2562]
[2563]
[2564]
[2565]
[2566]
[2567]
[2568]
[2569]
[2570]
[2571]
[2572]
[2573]
[2574]
[2575]
[2576]
[2577]
[2578]
[2579]
[2580]
[2581]
[2582]
[2583]
[2584]
[2585]
[2586]
[2587]
[2588]
[2589]
[2590]
[2591]
[2592]
[2593]
[2594]
[2595]
[2596]
[2597]
[2598]
[2599]
[2600]
[2601]
[2602]
[2603]
[2604]
[2605]
[2606]
[2607]
[2608]
[2609]
[2610]
[2611]
[2612]
[2613]
[2614]
[2615]
[2616]
[2617]
[2618]
[2619]
[2620]
[2621]
[2622]
[2623]
[2624]
[2625]
[2626]
[2627]
[2628]
[2629]
[2630]
[2631]
[2632]
[2633]
[2634]
[2635]
[2636]
[2637]
[2638]
[2639]
[2640]
[2641]
[2642]
[2643]
[2644]
[2645]
[2646]
[2647]
[2648]
[2649]
[2650]
[2651]
[2652]
[2653]
[2654]
[2655]
[2656]
[2657]
[2658]
[2659]
[2660]
[2661]
[2662]
[2663]
[2664]
[2665]
[2666]
[2667]
[2668]
[2669]
[2670]
[2671]
[2672]
[2673]
[2674]
[2675]
[2676]
[2677]
[2678]
[2679]
[2680]
[2681]
[2682]
[2683]
[2684]
[2685]
[2686]
[2687]
[2688]
[2689]
[2690]
[2691]
[2692]
[2693]
[2694]
[2695]
[2696]
[2697]
[2698]
[2699]
[2700]
[2701]
[2702]
[2703]
[2704]
[2705]
[2706]
[2707]
[2708]
[2709]
[2710]
[2711]
[2712]
[2713]
[2714]
[2715]
[2716]
[2717]
[2718]
[2719]
[2720]
[2721]
[2722]
[2723]
[2724]
[2725]
[2726]
[2727]
[2728]
[2729]
[2730]
[2731]
[2732]
[2733]
[2734]
[2735]
[2736]
[2737]
[2738]
[2739]
[2740]
[2741]
[2742]
[2743]
[2744]
[2745]
[2746]
[2747]
[2748]
[2749]
[2750]
[2751]
[2752]
[2753]
[2754]
[2755]
[2756]
[2757]
[2758]
[2759]
[2760]
[2761]
[2762]
[2763]
[2764]
[2765]
[2766]
[2767]
[2768]
[2769]
[2770]
[2771]
[2772]
[2773]
[2774]
[2775]
[2776]
[2777]
[2778]
[2779]
[2780]
[2781]
[2782]
[2783]
[2784]
[2785]
[2786]
[2787]
[2788]
[2789]
[2790]
[2791]
[2792]
[2793]
[2794]
[2795]
[2796]
[2797]
[2798]
[2799]
[2800]
[2801]
[2802]
[2803]
[2804]
[2805]
[2806]
[2807]
[2808]
[2809]
[2810]
[2811]
[2812]
[2813]
[2814]
[2815]
[2816]
[2817]
[2818]
[2819]
[2820]
[2821]
[2822]
[2823]
[2824]
[2825]
[2826]
[2827]
[2828]
[2829]
[2830]
[2831]
[2832]
[2833]
[2834]
[2835]
[2836]
[2837]
[2838]
[2839]
[2840]
[2841]
[2842]
[2843]
[2844]
[2845]
[2846]
[2847]
[2848]
[2849]
[2850]
[2851]
[2852]
[2853]
[2854]
[2855]
[2856]
[2857]
[2858]
[2859]
[2860]
[2861]
[2862]
[2863]
[2864]
[2865]
[2866]
[2867]
[2868]
[2869]
[2870]
[2871]
[2872]
[2873]
[2874]
[2875]
[2876]
[2877]
[2878]
[2879]
[2880]
[2881]
[2882]
[2883]
[2884]
[2885]
[2886]
[2887]
[2888]
[2889]
[2890]
[2891]
[2892]
[2893]
[2894]
[2895]
[2896]
[2897]
[2898]
[2899]
[2900]
[2901]
[2902]
[2903]
[2904]
[2905]
[2906]
[2907]
[2908]
[2909]
[2910]
[2911]
[2912]
[2913]
[2914]
[2915]
[2916]
[2917]
[2918]
[2919]
[2920]
[2921]
[2922]
[2923]
[2924]
[2925]
[2926]
[2927]
[2928]
[2929]
[2930]
[2931]
[2932]
[2933]
[2934]
[2935]
[2936]
[2937]
[2938]
[2939]
[2940]
[2941]
[2942]
[2943]
[2944]
[2945]
[2946]
[2947]
[2948]
[2949]
[2950]
[2951]
[2952]
[2953]
[2954]
[2955]
[2956]
[2957]
[2958]
[2959]
[2960]
[2961]
[2962]
[2963]
[2964]
[2965]
[2966]
[2967]
[2968]
[2969]
[2970]
[2971]
[2972]
[2973]
[2974]
[2975]
[2976]
[2977]
[2978]
[2979]
[2980]
[2981]
[2982]
[2983]
[2984]
[2985]
[2986]
[2987]
[2988]
[2989]
[2990]
[2991]
[2992]
[2993]
[2994]
[2995]
[2996]
[2997]
[2998]
[2999]
[3000]
[3001]
[3002]
[3003]
[3004]
[3005]
[3006]
[3007]
[3008]
/*****************************************************************************/
#ifdef COMMENTS_WITH_COMMENTS
/*
                                 DCLinabox.c

JavaScript based VT102 terminal emulation using WASD WebSocket communication
with a pseudo-terminal connected VMS process.

Based on JavaScript code from the ShellInABox project:

  Copyright (C) 2008-2009 Markus Gutschke <markus@shellinabox.com>.

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License version 2 as
  published by the Free Software Foundation.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

http://code.google.com/p/shellinabox/

For all things VT100 (et.al.) ... http://vt100.net

For all things VT testing ... http://invisible-island.net/vttest/vttest.html

DCLinabox may be proctored into existence.

  # WASD_CONFIG_GLOBAL
  [DclScriptProctor]
  1 /cgiplus-bin/dclinabox /cgiplus-bin/dclinabox


CAUTION
-------
This WebSocket application allows remote login from a Web browser to the server
system.  This could be a security issue and so the script disables itself by
default.  Logical name value DCLINABOX_ENABLE controls whether this script can
be used.   Define this system-wide using a value of "*" to simply allow
experimentation.  Alternatively provide one or more comma-separated,
dotted-decimal IP address to specify one or more hosts allowed to use the
script, and/or one or more comman-separated IP addresses and CIDR subnet mask
to specify a range of hosts.  IPv4 only!  For example

  $ DEFINE /SYSTEM DCLINABOX_ENABLE "*"
  $ DEFINE /SYSTEM DCLINABOX_ENABLE "192.168.1.2"
  $ DEFINE /SYSTEM DCLINABOX_ENABLE "192.168.1.2,192.168.1.3"
  $ DEFINE /SYSTEM DCLINABOX_ENABLE "192.168.1.0/24"
  $ DEFINE /SYSTEM DCLINABOX_ENABLE "192.168.1.0/24,192.168.2.2"

By default the WebSocket, and hence all traffic to and from the DCLinabox login
and session, is only allowed over Secure Sockets Layer.  To allow access via
clear-text connections add "ws:" somewhere in the logical name value.

  $ DEFINE /SYSTEM DCLINABOX_ENABLE "ws:,*"
  $ DEFINE /SYSTEM DCLINABOX_ENABLE "192.168.1.0/24,ws:,192.168.2.2"


ASYNCHRONOUS PROCESSING
-----------------------
There are multiple sources of asynchronous events in this code.

1) The pseudo-terminal driver reads and writes asynchronously from the
terminal channel.  Other events, such as flow control, can be delivered at any
time.

2) The process created to host the terminal session has a termination mailbox
that can be delivered at any time, during terminal I/O, server-script I/O, and
host name lookup.

3) The ACCPORNAM data can use TCP/IP Services host name from IP address
ACPCONTROL QIOs.  While this action is undertaken before commencing terminal
I/O it would be possible for the terminal process to terminate very early and
have the associated AST deliver during host name lookup processing.


ACCPORNAM and CMKRNL
--------------------
From The System Services Reference manual:

  DVI$_TT_ACCPORNAM

  Returns the name of the remote access port associated with a channel number
  or with a physical or virtual terminal device number. If you specify a
  device that is not a remote terminal or a remote type that does not support
  this feature, $GETDVI returns a null string. The $GETDVI service returns
  the access port name as a string. HP recommends a buffer size of 64 bytes
  to return the name of the remote access port.

  The $GETDVI service returns the name in the format of the remote system. If
  the remote system is a LAT terminal server, $GETDVI returns the name as
  server_name/port_name. The names are separated by the slash (/) character.
  If the remote system is an X.29 terminal, the name is returned as
  network.remote_DTE. For devices using TCP/IP, the name is returned in the
  format Host: 192.168.1.100 Port: 1.

  When writing applications, use the string returned by DVI$_ACCPORNAM
  (instead of the physical device name) to identify remote terminals.

DCLinabox optionally supports the setting of this field, with

  "inabox/<client-IP-address>:<client-IP-port>"

Optional build via macro ACCPORNAM_BUILD (defaiult enabled), and also optional
when built that way via CMKRNL privilege.  When DCLINABOX.EXE is INSTALLed with
CMKRNL, kernel-mode mode is used to modify a data structure (UCB) associated
with the terminal device to contain such a value.  If not INSTALLed with CMKRNL
this is not performed.  DCLinabox behaviour is not otherwise modified.

To help monitor potential leakage of NPP, when the image exits DCLinabox emits
an OPCOM message giving three numbers, the number of times the ACCPORNAM code
was accssed, the number of times successfully set and the number of times
resets.  Ideally, the second and third should be identical and the first the
sum of the two.

Whenever kernel-mode code is executed there is a small risk to the system, and
that risk grows exponentially with the less experienced author.  The code in
DCLinabox has been put together by MGD who has had no previous internals
experience.  Should your system go down in a screaming heap and it be analysed
to be due to DCLinabox please refer...

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

...and remove CMKRNL from the DCLinabox executable.


LOGIN PROMPT
------------
By default the DCLinabox CONNECT dialogue has username and password fields
associated with it. This can be disabled by configuration.

These fields and associated form structure are commonly recognised by browsers'
password management capabilities and may be used to supply login credentials to
the VMS system.

DCLINABOX.C detects the system's login Username: and Password: prompts and for
each supplies an escape sequence to the JavaScript front-end requesting the
supply of any corresponding fields supplied with the CONNECT.  If available,
and on the first occurance, these simple strings are returned via the data
stream just as if typed into the VT emulation.  Voila!


SINGLE SIGN-ON
--------------
By default, DCLinabox terminal sessions prompt for a username and password. 
For sites where WASD SYSUAF authentication is available, or where the
authenticated remote user string is the equivalent of a VMS username, DCLinabox
can use that authenticated VMS username to establish a terminal session without
further credential input (i.e. the terminal just displays the DCL prompt, ready
to go).

THIS IS OBVIOUSLY VERY POWERFUL AND SHOULD ONLY BE USED WITH DUE CAUTION!

The functionality is enabled using the DCLINABOX_SSO logical name.  This
logical name is multi-valued, allowing considerable granularity in establishing
allowed use of the facility.  Each value begins with the name of the realm
associated with authentication of the VMS username.  This is separated by an
equate symbol and then one or more comma-separated usernames and/or wildcard
allowed to single sign-on.  Preceding a username with a '!' (exclamation point)
disallows the matching username to SSO.  All string matches are
case-insensitive.

Account restrictions (e.g. times) are not evaluated.  If a specific username
matches it is permitted regardless of the account privileges.  If a '**'
(double asterisk) is specified any username is permitted regardless of the
account privileges.  If a '*' (single asterisk) is specified any non-privileged
account is permitted to SSO.  If '!*' (exclamation point then asterisk) is
specified DCLinabox cannot be used except if permitted by SSO.

For example, the following authentication rule

  ["VMS credentials"=WASD_VMS_RW=id]
  /cgi*-bin/dclinabox* r+w,https:

would require the logical name defintion

  $ DEFINE /SYSTEM DCLINABOX_SSO "WASD_VMS_RW=*"

to allow any such non-privileged authenticated user to create a logged-in
terminal session, while the logical name definition

  $ DEFINE /SYSTEM DCLINABOX_SSO "WASD_VMS_RW=REN,STIMPY"

would allow only users REN and STIMPY to do so.  The logical name definition

  $ DEFINE /SYSTEM DCLINABOX_SSO "WASD_VMS_RW=**"

would allow any account (privileged or non-privileged) to SSO, and

  $ DEFINE /SYSTEM DCLINABOX_SSO "WASD_VMS_RW=REN,!STIMPY,*"

allows (perhaps privileged) REN but not STIMPY, and then any other
non-privileged account.

If a matching authentication realm is not present, or a matching username in a
matched realm is not found, or a disabling account status, then single sign-on
does not occur and the terminal session just prompts for credentials as usual. 
Of course, even if the logical name does not allow SSO, the access to DCLinabox
is still controlled by the web server authentication and authorisation.

The logical name DCLINABOX_ANNOUNCE allows an SSO session establishment
announcement to be displayed in the terminal window.  This multi-valued logical
name appends carriage-control to each value displaying it as separate line.

Single sign-on requires the executable image to be installed with privileges to
allow UAI and persona services to be used.  System startup requires (includes
WORLD required for process name update)

  $  INSTALL ADD CGI-BIN:[000000]DCLINABOX.EXE /AUTH=(DETACH,SYSPRV,WORLD)

and on executable image update

  $  INSTALL REPLACE CGI-BIN:[000000]DCLINABOX.EXE


TERMINAL TITLE
--------------
By default the terminal title bar displays the DCLinabox host name, VMS node
name and username.  To display the process name in addition (periodically
updated if changes) the executable image needs to be installed with WORLD
privilege.  System startup requires

  $  INSTALL ADD CGI-BIN:[000000]DCLINABOX.EXE /AUTH=(WORLD)

and on executable image update

  $  INSTALL REPLACE CGI-BIN:[000000]DCLINABOX.EXE


IDLE SESSION
------------
An idle session is one not having terminal input for a given period.  By
default idle sessions are disconnected after two hours with a five minute
warning.  The logical name DCLINABOX_IDLE allows the number of minutes before
client disconnection to be specified, the number of minutes warning (delivered
in a browser alert), and the warning message (allowing language customisation). 
Each of these elements is delimited by a comma.  Idle session management may be
changed at any time and is propagated to new and existing sessions.

Define to -1 to to disable idle disconnection: 

  $ DEFINE /SYSTEM DCLINABOX_IDLE -1

To specify a one hour idle period with 5 minute warning:

  $ DEFINE /SYSTEM DCLINABOX_IDLE "60,5"

To specify a six hour idle period with ten minute warning and local warning
message (which may contain just one "%d" to substitute the minutes warning):

  $ DEFINE /SYSTEM DCLINABOX_IDLE -
  "360,10,WARNING - disconnection in %d minutes!"


SESSION ANNOUNCEMENT
--------------------
The logical name DCLINABOX_ALERT results in an announcement being displayed in
a browser alert dialog.  This alert will be delivered at session establishment
if it exists at the time, perhaps as a permanent announcement, otherwise will
be alerted within a minute of it first being defined.  If an ephemeral
announcement it should be undefined when no longer relevant.  For example

  $ DEFINE /SYSTEM DCLINABOX_ALERT -
  "*** DCLinabox restart shortly - PLEASE LOG OFF ***"


RENAMING THE INTERFACE
-----------------------
The DCLINABOX.EXE file may be alternately named.  With a public system this may
be useful for reducing nuisance-value access attempts and/or an obvious attack
vector by obscuring the web interface.  Just use an obscured (or
access-controlled) HTML terminal page, a different script executable file name,
and add that script name to the <head>..</head> section of the HTML terminal
file as with other per-terminal configuration vardisableds.

  <script type="text/javascript"><!--
  DCLinaboxScriptName = "anexample";               
  //--></script>

The script accessed will then be /cgiplus-bin/anexample.

The logical names used would then be ANEXAMPLE_ENABLE, etc.


COPYRIGHT
---------
Copyright (C) 2011-2024 Mark G.Daniel
This program comes with ABSOLUTELY NO WARRANTY.
This is free software, and you are welcome to redistribute it under the
conditions of the GNU GENERAL PUBLIC LICENSE, version 3, or any later version.
http://www.gnu.org/licenses/gpl.txt


VERSION HISTORY
---------------
25-OCT-2024  MGD  v1.7.5,
                  bugfix; call lib$lock_image() only the once
28-SEP-2024  MGD  V1.7.4,
                  KrnlSetAccPorNam() wrap access with lib$lock_image()
                     and device_lock();
04-JAN-2024  MGD  v1.7.3,
                  bump version for JavaScript changes to paste functionality
26-OCT-2021  MGD  v1.7.2,
                  builds under IA64-hosted X86 cross-compiler
17-APR-2021  MGD  v1.7.1,
                  allow for v12.0 and later script process nomenclature
29-MAR-2021  MGD  v1.7.0,
                  can now be proctored into being
                  set terminal TT_ACCPORNAM (requires CMKRNL)
                  JavaScript enhancements (virtual keyboard)
03-OCT-2020  MGD  v1.6.0,
                  Allow F1..F12 on PC-style keyboards,
                     and option-F1..F12 with option-F16..F19 on Mac extended,
                     to be available as VT220-style function keys
                  Long Line Edit (LLE) facility
                  client control of hex dump terminal input and system output
19-NOV-2016  MGD  v1.5.0,
                  login credential escapes
                  VT100.js and DCLinabox.js enhancements
18-JUL-2016  MGD  v1.4.0,
                  support DEC SHDW, DHDW, DECELR and DECSLE
                    as VT100.js enhancements 
                  add version-dependent query-string to .css and .js resource
                    loads in an effort to make resource updates less painful
                    (works with big 4; Chrome, Firefox, Safari, Edge (MSIE))
12-MAY-2015  MGD  v1.3.1,
                  keep-alive (help prevent proxy disconnect)
17-MAR-2015  MGD  v1.3.0,
                  allow executable to initiate session
                  allow for use within the WASD acme environment
20-DEC-2013  MGD  v1.2.1,
                  bugfix; VT100.JS for Firefox [-_] keycode
14-JUL-2013  MGD  v1.2.0,
                  XON/XOFF flow control to accomodate bulk pastes
                  make input buffer dynamic (for paste)
                  DCLINABOX.JS paste portal
10-NOV-2012  MGD  v1.1.1,
                  bugfix; SessionManagement() NULL pointer
01-OCT-2012  MGD  v1.1.0,
                  single sign-on (no-password required terminal)
                  dynamic terminal resize
                  set terminal title to include logon detail
                  DCLINABOX.EXE/JavaScript IPC 'escape' sequences
                  refine idle session management
                  refine process termination signaling
                  bugfix; PtdClose() queued read and *write*
21-JUL-2012  MGD  v1.0.1,
                  bugfix; ptd$delete() during client removal
                  bugfix; AddClient() lib$free_vm_page() memory
04-DEC-2011  MGD  v1.0.0,
                  initial development
*/
#endif /* COMMENTS_WITH_COMMENTS */
/*****************************************************************************/

#define SOFTWAREVN "1.7.5"
/*                  ^^^^^ and correspondingly update  DCLINABOX.JS
                                                 and  DCLINABOX.HTML
                                                 and  LOADINABOX.JS
*/
#define SOFTWARENM "DCLINABOX"
#define SOFTWARECR "Copyright (C) 2011-2024 Mark G.Daniel"
#ifdef __ALPHA
#  define SOFTWAREID SOFTWARENM " AXP-" SOFTWAREVN
#endif
#ifdef __ia64
#  define SOFTWAREID SOFTWARENM " IA64-" SOFTWAREVN
#endif
#ifdef __VAX
#  error VAX no longer implemented
#endif
#ifdef __x86_64
#  define SOFTWAREID SOFTWARENM " X86-" SOFTWAREVN
#endif

#define VERSIONQS "?" SOFTWAREVN

#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <ctype.h>
#include <errno.h>
#include <inet.h>
#include <ints.h>
#include <netdb.h>
#include <unixlib.h>

#include <accdef.h>
#include <cmbdef.h>
#include <descrip.h>
#include <dvidef.h>
#include <iodef.h>
#include <iosbdef.h>
#include <issdef.h>
#include <jpidef.h>
#include <lib$routines.h>
#include <lnmdef.h>
#include <opcdef.h>
#include <prcdef.h>
#include <prvdef.h>
#include <ptddef.h>
#include <starlet.h>
#include <ssdef.h>
#include <stsdef.h>
#include <syidef.h>
#include <ttdef.h>
#include <tt2def.h>
#include <uaidef.h>

#include "wslib.h"

#define DC$_TERM 6

#define VMSok(x) ((x) & STS$M_SUCCESS)
#define VMSnok(x) !(((x) & STS$M_SUCCESS))

#define dbug 0

/* enables more developer OPCOM messages */
#ifndef OPCOM_DBUG
# define OPCOM_DBUG 0
#endif

#ifdef __x86_64
# define ACCPORNAM_BUILD 0
#endif

#ifndef ACCPORNAM_BUILD
# define ACCPORNAM_BUILD 1
/* for experimentation do not deallocate NPP */
# define ACCPORNAM_LEAK 0
#endif
#define ACCPORNAM_PREFIX "inabox/"

#define FI_LI "DCLINABOX", __LINE__
#define EXIT_FI_LI(status) { printf ("[%s:%d]", FI_LI); exit(status); }

/* an unlikely sequence for end-use terminal output (avoid nulls) */
#define DCLINABOX_ESCAPE "\r\x02" "DCLinabox\x03\r\\"
#define DCLINABOX_ESCAPE4 '\x0d\x02\x44\x43'

#define CONTROL_HUH "Huh?"
#define HEXDUMP_SIZE ((PTD_READ_SIZE * 4) + 1)
#define HEX_DIGITS "0123456789ABCDEF"

/* basically the page size on the architecture */
#define PTD_READ_SIZE 8192
#define PTD_WRITE_SIZE 8192

#define DEFAULT_IDLE_MINS    120
#define DEFAULT_WARN_MINS      5
#define DEFAULT_WARN_MESSAGE "This idle terminal will be disconnected " \
                             "in %d minutes!"

int  AccPorNamCount,
     AccPorNamSetCount,
     AccPorNamResetCount,
     ConnectedCount,
     ProctoredScript = -1,
     UsageCount,
     VmsVersionInteger = 720;

unsigned long  ScriptPid,
               ScriptUic;

char  AlertLogicalName [128],
      AnnounceLogicalName [128],
      EnableLogicalName [128],
      IdleLogicalName [128],
      SingleLogicalName [128];

char  AccPorNamPrefix [] = ACCPORNAM_PREFIX,
      DCLinaboxEscape [] = DCLINABOX_ESCAPE,
      ConsoleEscape [] =   DCLINABOX_ESCAPE "F", /* + any old string */ 
      AlertEscape [] =     DCLINABOX_ESCAPE "A", /* + message string */
      DelayEscape [] =     DCLINABOX_ESCAPE "9", /* + integer string */
      KeepAliveEscape [] = DCLINABOX_ESCAPE "8",
      LogoutEscape [] =    DCLINABOX_ESCAPE "7",
      PasswordEscape [] =  DCLINABOX_ESCAPE "6",
      TermSizeEscape [] =  DCLINABOX_ESCAPE "5", /* + WxH string */
      TerminateEscape [] = DCLINABOX_ESCAPE "4",
      TitleEscape [] =     DCLINABOX_ESCAPE "3", /* +title string */
      UsernameEscape [] =  DCLINABOX_ESCAPE "2",
      VersionEscape [] =   DCLINABOX_ESCAPE "1" SOFTWAREVN;

struct PtdClient
{
   /* keep these adjacent and aligned on a page boundary */
   char  PtdReadBuffer [PTD_READ_SIZE],
         PtdWriteBuffer [PTD_WRITE_SIZE];

   int  Alerted,
        IdleMins,
        LogoutResponse,
        OnToSystem,
        ProcessPid,
        PtdQueuedRead,
        PtdQueuedWrite,
        PtdReadCount,
        PtdWriteCount,
        WatchScript,
        WarnMins,
        WriteDelayStatus,
        XoffRx;

   unsigned long  ClientCount,
                  DviOwnUic,
                  DviPid,
                  IdleCount,
                  IdleTime,
                  TermMbxUnit,
                  WarnTime,
                  WriteCount;

   unsigned long  WriteDelay[2];

   unsigned short  ptdchan,
                   TermMbxChannel;

   char  *ClientHex,
         *SystemHex,
         *WritePtr;

   char  AccPorNam [1+64],  /* counted string */
         DviHostName [8+1],
         HttpHost [64],
         JpiPrcNam [15+1],
         OwnIdent [31+1],
         PtdDevName [64],
         RemoteAddr [31+1],
         RemoteHost [127+1],
         RemotePort [15+1],
         VmsUserName [12];

   char  TermAccount [ACC$C_TERMLEN];

   struct dsc$descriptor_s  PtdDevNameDsc;

   struct WsLibStruct  *WsLibPtr;
};

long  PtdClientPages = (sizeof(struct PtdClient) / 512 ) + 1;

long  CharBuf [3];

/* function prototypes */
void AddClient ();
void AdviseClientTermSize (struct PtdClient*);
void ClientEscape (struct PtdClient*, char*, int);
void ConsoleCallout (struct PtdClient*, char*, int, char*, ...);
int DCLinaboxEnable ();
void DCLinaboxExit ();
int DCLinaboxSingleSignOn (struct PtdClient*);
void LookupHostName (void*, void*, char*, char*);
int MinimumWASD (char*);
void OpcomMessage (char*, ...);
void PtdBegin (struct PtdClient*);
void PtdClose (struct PtdClient*);
int PtdCrePrc (struct PtdClient*);
void PtdCrePrcTerminateAst (struct PtdClient*);
void PtdRead (struct PtdClient*);
void PtdReadClient (struct WsLibStruct*);
void PtdRemoveClient (struct WsLibStruct *wsptr);
void PtdTerminateAst (struct PtdClient*);
void PtdTerminateFree (struct PtdClient*);
void PtdReadAst (struct PtdClient*);
void PtdReadWriteAst (struct WsLibStruct*);
void PtdReadWriteDelay (struct WsLibStruct*);
void PtdXoffAst (struct PtdClient*);
void PtdXonAst (struct PtdClient*);
void PtdWrite (struct PtdClient*, char*, int);
void PtdWriteAst (struct PtdClient*);
void ScriptCallout (char*, ...);
void SessionManagement ();
char* SysTrnLnm (char*, char*, int);

int SetAccPorNam (ushort, char[]);
void SetClientAccPorNam (struct PtdClient*);
int KrnlSetAccPorNam (int, char[], __int32*);

/*****************************************************************************/
/*
AST delivery is disabled during client acceptance and the add-client function
is deferred using an AST to help minimise the client setup window with a
potentially busy WebSocket application.
*/

main (int argc, char *argv[])

{
   static unsigned long  JpiPidItem = JPI$_PID,
                         JpiPrcNamItem = JPI$_PRCNAM,
                         JpiUicItem = JPI$_UIC;

   int  ilen, status;
   ushort  slen;
   char  *aptr, *cptr, *sptr, *zptr,
         *wxh;
   char  PrcNam [15+1];
   $DESCRIPTOR (PrcNamDsc, PrcNam);

   /*********/
   /* begin */
   /*********/

   if (argc > 1)
   {
      if (strcasecmp(argv[1],"/version") == 0)
      {
         fprintf (stdout, "%%DCLINABOX-I-VERSION, %s %s\n",
                  SOFTWAREID, WsLibVersion());
         exit (SS$_NORMAL);
      }
   }

   /* note the scripting account's PID and UIC */
   lib$getjpi (&JpiPidItem, 0, 0, &ScriptPid, 0, 0);
   lib$getjpi (&JpiPrcNamItem, 0, 0, 0, &PrcNamDsc, &slen);
   PrcNam[slen] = '\0';
   lib$getjpi (&JpiUicItem, 0, 0, &ScriptUic, 0, 0);

#if ACCPORNAM_BUILD
   OpcomMessage ("!AZ begin !8XL", SOFTWAREID, ScriptPid);
#endif

   /* don't want the C-RTL fiddling with the carriage control */
   stdout = freopen ("SYS$OUTPUT", "w", stdout, "ctx=bin");

   WsLibInit ();

   /* set the terminal characteristics */
   CharBuf[0] = (80 << 16) | (TT$_LA100 << 8) | DC$_TERM;
   CharBuf[1] = (24 << 24) |
                TT$M_EIGHTBIT | TT$M_SCOPE | TT$M_WRAP |
                TT$M_MECHTAB | TT$M_LOWER | TT$M_TTSYNC;
   CharBuf[2] = TT2$M_EDIT | TT2$M_DRCS | TT2$M_EDITING | TT2$M_HANGUP;

   /* parse out the executable file name */
   for (aptr = argv[0]; *aptr; aptr++);
   while (aptr > argv[0] && *aptr != ']') aptr--;
   if (*aptr++ != ']') EXIT_FI_LI (SS$_BUGCHECK);

   /* if the excutable is DCLINABOX.EXE then use "DCLinabox" */
   if (strncasecmp (aptr, cptr = "DCLinabox", 9)) cptr = aptr;

   if (PrcNam[0] != '/')
   {
      /* not using v12 script process nomenclature */
      for (sptr = PrcNam; *cptr && sptr < PrcNam+10; *sptr++ = *cptr++);
      sprintf (sptr, "_%4.4X", ScriptPid & 0xffff);
      PrcNamDsc.dsc$w_length = strlen(PrcNam);
      if (!(status = sys$setprn (&PrcNamDsc) & 1)) EXIT_FI_LI (status);
   }

   /* generate the logical names from the executable file name */
   zptr = (sptr = AlertLogicalName) + sizeof(AlertLogicalName)-16;
   for (cptr = aptr;
        *cptr && *cptr != '.' && sptr < zptr;
        *sptr++ = toupper(*cptr++));
   ilen = sptr - AlertLogicalName;
   strcpy (AlertLogicalName+ilen, "_ALERT");
   strncpy (AnnounceLogicalName, AlertLogicalName, ilen);
   strcpy (AnnounceLogicalName+ilen, "_ANNOUNCE");
   strncpy (EnableLogicalName, AlertLogicalName, ilen);
   strcpy (EnableLogicalName+ilen, "_ENABLE");
   strncpy (IdleLogicalName, AlertLogicalName, ilen);
   strcpy (IdleLogicalName+ilen, "_IDLE");
   strncpy (SingleLogicalName, AlertLogicalName, ilen);
   strcpy (SingleLogicalName+ilen, "_SSO");

   /* no clients is five minutes in seconds */
   WsLibSetLifeSecs (5*60);

   atexit (&DCLinaboxExit);

   SessionManagement ();

   for (;;)
   {
      WsLibCgiVar ("");

      if (!MinimumWASD ("10.1.0"))
      {
         fprintf (stdout, "Status: 500\r\n\r\nMinimum WASD v10.1.0!\n");
         exit (SS$_NORMAL);
      }

      if (ProctoredScript < 0)
      {
         /**************/
         /* proctored? */
         /**************/

         ProctoredScript = !*WsLibCgiVar ("REMOTE_ADDR") &&
                           !*WsLibCgiVar ("SERVER_ADDR");
         if (ProctoredScript)
         {
            ScriptCallout ("!LIFETIME: DO-NOT-DISTURB\n");
            fprintf (stdout, "Status: 204\n\n");
            WsLibCgiPlusEof ();
            continue;
         }
      }

      if (!WsLibIsCgiPlus())
      {
         /*******************/
         /* must be CGIplus */
         /*******************/

         if (strncasecmp (cptr = WsLibCgiVar("REQUEST_URI"), "/cgi-bin/", 9))
         {
            /* not the "standard" path */
            fprintf (stdout, "Status: 500\r\n\r\nMust be CGIplus!\n");
         }
         else
         {
            /* redirect to "standard" CGIplus path */
            fprintf (stdout,
"Status: 302\r\n\
Location: /cgiplus-bin/%s\r\n\
\r\n\
Must be CGIplus!\n",
                     cptr+9);
         }
         exit (SS$_NORMAL);
      }

      if (WsLibCgiVarNull ("WEBSOCKET_INPUT"))
      {
         /*****************/
         /* WebSocket IPC */
         /*****************/

         sys$setast (0);
         UsageCount++;
         if (DCLinaboxEnable()) AddClient ();
         sys$setast (1);
      }
      else
      {
         /*********************/
         /* initiate terminal */
         /*********************/

         if (!strncmp(WsLibCgiVar("QUERY_STRING"),"frame=",6))
            cptr = "acme";
         else
            cptr = "loadinabox";

         sptr = WsLibCgiVar("SCRIPT_NAME");

         fprintf (stdout,
"Content-Type: text/html\r\n\
\r\n\
<!DOCTYPE html>\n\
<html>\n\
<head>\n\
<title>DCLinabox</title>\n\
<meta http-equiv=\"X-UA-Compatible\" content=\"IE=edge\">\n\
<meta name=\"copyright\" content=\"%s - GPL licensed\">\n\
<script language=\"JavaScript\">\n\
var $ExeVersion = \'%s\';\n\
var $NoLoad = \'JavaScript not loading!\';\n\
var $ScriptName = \'%s\';\n\
var $WebSocket = true;\n\
function $LoadError() { alert($NoLoad); \
document.getElementsByTagName(\'body\')[0].innerHTML += $NoLoad; }\n\
</script>\n\
<script type=\"text/javascript\" onerror=\"$LoadError()\" \
src=\"/dclinabox/-/%s.js%s\"></script>\n\
</head>\n\
<body>\n\
DCLinabox v%s <noscript>requires JavaScript!</noscript>\n\
</body>\n\
</html>\n",
                 SOFTWARECR, SOFTWAREVN, sptr, cptr,
                 VERSIONQS, SOFTWAREVN);
      }

      WsLibCgiPlusEof ();
   }

   exit (SS$_NORMAL);
}

/*****************************************************************************/
/*
*/

void DCLinaboxExit ()

{
   struct PtdClient  *clptr;
   struct WsLibStruct  *wsptr = NULL; 

   /*********/
   /* begin */
   /*********/

#if ACCPORNAM_BUILD
   OpcomMessage ("!AZ end !8XL !UL/!UL/!UL", SOFTWAREID, ScriptPid,
                 AccPorNamCount, AccPorNamSetCount, AccPorNamResetCount);

   while (WsLibNext(&wsptr))
   {
      clptr = WsLibGetUserData(wsptr);
      if (clptr->ptdchan)
         if (clptr->AccPorNam[0])
            SetAccPorNam (clptr->ptdchan, "");
      OpcomMessage ("!UL/!UL/!UL",
                    AccPorNamCount, AccPorNamSetCount, AccPorNamResetCount);
   }
#endif

   sys$delprc (0, 0, 0);
}

/*****************************************************************************/
/*
Allocate a client structure and add it to the head of the list.  Establish the
WebSocket IPC, create the user terminal (and process if SSO) and begin
processing.
*/

void AddClient ()

{
   int  idx, len, sso, status;
   short int  slen;
   char  *aptr, *cptr, *sptr, *zptr;
   char  AlertMsg [sizeof(AlertEscape)+256],
         AnnounceLine [256+2];
   struct PtdClient  *clptr;
   $DESCRIPTOR (AlertMsgDsc, AlertMsg);

   /*********/
   /* begin */
   /*********/

#if OPCOM_DBUG
   OpcomMessage ("S/AddClient() !UL/!UL/!UL",
                 AccPorNamCount, AccPorNamSetCount, AccPorNamResetCount);
#endif

   /* PTD$ buffers must be page aligned */
   status = lib$get_vm_page (&PtdClientPages, &clptr);
   if (VMSnok(status)) EXIT_FI_LI (status);
   memset (clptr, 0, sizeof(struct PtdClient));

   if (cptr = WsLibCgiVarNull("HTTP_HOST"))
   {
      zptr = (sptr = clptr->HttpHost) + sizeof(clptr->HttpHost)-1;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
   }

   strcpy (clptr->OwnIdent, "<nobody>");

   /* create a WebSocket library structure for the client */
   if (!(clptr->WsLibPtr = WsLibCreate (clptr, PtdRemoveClient)))
   {
      /* failed, commonly on some WebSocket protocol issue */
      status = lib$free_vm_page (&PtdClientPages, &clptr);
      if (VMSnok(status)) EXIT_FI_LI (status);
      return;
   }

   /* open the IPC to the WebSocket (mailboxes) */
   status = WsLibOpen (clptr->WsLibPtr);
   if (VMSnok(status)) EXIT_FI_LI(status);

   clptr->WatchScript = (WsLibCgiVarNull ("WATCH_SCRIPT") != NULL);
   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI, "AddClient() %d %s %d (%d/%d/%d)",
                      clptr->ptdchan, SOFTWAREID, ConnectedCount,
                      AccPorNamCount, AccPorNamSetCount, AccPorNamResetCount);

   status = PtdCrePrc (clptr);

   /* inform the JavaScript which version executable it's dealing with */
   WsLibWrite (clptr->WsLibPtr, VersionEscape,
               sizeof(VersionEscape)-1, WSLIB_ASYNCH);

   if (VMSnok (status))
   {
      /* unsuccessful terminal alert */
      zptr = (sptr = AlertMsg) + sizeof(AlertMsg)-1;
      for (cptr = AlertEscape; *cptr && sptr < zptr; *sptr++ = *cptr++);
      if (sptr < zptr) *sptr++ = '\"';
      AlertMsgDsc.dsc$a_pointer = sptr;
      AlertMsgDsc.dsc$w_length = sizeof(AlertMsg) - (sptr - AlertMsg);
      sys$getmsg (status, &slen, &AlertMsgDsc, 1, 0); 
      sptr += slen;
      if (sptr < zptr) *sptr++ = '\"';
      WsLibWrite (clptr->WsLibPtr, AlertMsg, sptr-AlertMsg, WSLIB_ASYNCH);
      WsLibClose (clptr->WsLibPtr, 0, NULL);
      return;
   }
   else
   if (aptr = SysTrnLnm (AlertLogicalName, NULL, 0))
   {
      /* successful terminal alert */
      zptr = (sptr = AlertMsg) + sizeof(AlertMsg)-1;
      for (cptr = AlertEscape; *cptr && sptr < zptr; *sptr++ = *cptr++);
      for (cptr = aptr; *cptr && sptr < zptr; *sptr++ = *cptr++);
      WsLibWrite (clptr->WsLibPtr, AlertMsg, sptr-AlertMsg, WSLIB_ASYNCH);
      clptr->Alerted = 1;
   }

   if (VMSok (status) && clptr->VmsUserName[0])
   {
      /* single sign-on terminal */
      for (idx = 0; idx <= 127; idx++)
      {
         if (!SysTrnLnm (AnnounceLogicalName, AnnounceLine, idx)) break;
         slen = strlen(AnnounceLine);
         AnnounceLine[slen++] = '\r';
         AnnounceLine[slen++] = '\n';
         WsLibWrite (clptr->WsLibPtr, AnnounceLine, slen, WSLIB_ASYNCH);
      }
   }

   /* queue an asynchronous read into dynamic buffer from the client */
   WsLibRead (clptr->WsLibPtr, NULL, 0, PtdReadClient);

   ConnectedCount++;
}

/*****************************************************************************/
/*
Remove the client structure from the list and free the memory.
*/

void PtdRemoveClient (struct WsLibStruct *wsptr)

{
   int  status;
   struct PtdClient  *clptr;

   /*********/
   /* begin */
   /*********/

   clptr = WsLibGetUserData(wsptr);

   if (clptr->ptdchan) status = ptd$delete (clptr->ptdchan);
}

/*****************************************************************************/
/*
Open a pseudo-terminal attached to a detached process created as the specified
VMS user account.
*/

#define ISS$C_ID_NATURAL 1
#define IMP$M_ASSUME_SECURITY 1
#define IMP$M_ASSUME_DEFPRIV  8

int PtdCrePrc (struct PtdClient *clptr)

{
   static unsigned long  CrePrcFlagsLogin = PRC$M_DETACH |
                                            PRC$M_INTER,
                         CrePrcFlagsSSO = PRC$M_DETACH |
                                          PRC$M_INTER |
                                          PRC$M_NOPASSWORD,
                         DevNamItem = DVI$_DEVNAM,
                         DviUnitItem = DVI$_UNIT,
                         UnitItem = DVI$_UNIT;
   static unsigned long  NeedPrvMask [2] = { PRV$M_SYSPRV | PRV$M_DETACH, 0 };
   static $DESCRIPTOR (LoginOutDsc, "SYS$SYSTEM:LOGINOUT.EXE");
   static char  UnitNumber [16];
   static $DESCRIPTOR (UnitNumberDsc, UnitNumber);
  
   int  ptatus, status,
        PersonaHandle;
   unsigned long  flags;
   short  sLength;
   long  InAdr [2];
   $DESCRIPTOR (PrcNamDsc, clptr->PtdDevName);
   $DESCRIPTOR (PtdDevNameDsc, clptr->PtdDevName);
   $DESCRIPTOR (UserNameDsc, clptr->VmsUserName);

   /*********/
   /* begin */
   /*********/

   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI, "PtdCrePrc() %d", clptr->ptdchan);

   if (clptr->VmsUserName[0])
   {
      /******************/
      /* assume persona */
      /******************/

      UserNameDsc.dsc$w_length = strlen(clptr->VmsUserName);

      ptatus = sys$setprv (1, &NeedPrvMask, 0, 0);
      if (VMSnok (ptatus)) EXIT_FI_LI(ptatus);

      PersonaHandle = 0;
      status = sys$persona_create (&PersonaHandle, &UserNameDsc,
                                   ISS$M_CREATE_AUTHPRIV, 0, 0);

      if (VMSok (status))
      {
         if (VmsVersionInteger >= 720)
            status = sys$persona_assume (&PersonaHandle, 0, 0, 0);
         else
            status = sys$persona_assume (&PersonaHandle,
                                         IMP$M_ASSUME_SECURITY, 0, 0);
      }

      flags = CrePrcFlagsSSO;
   }
   else
   {
      status = SS$_NORMAL,
      flags = CrePrcFlagsLogin;
   }

   /**************************/
   /* create pseudo terminal */
   /**************************/

   if (VMSok (status))
   {
      InAdr[0] = (int)(clptr->PtdReadBuffer);
      InAdr[1] = (int)(clptr->PtdReadBuffer +
                       sizeof(clptr->PtdReadBuffer) +
                       sizeof(clptr->PtdWriteBuffer)-1);

      status = ptd$create (&clptr->ptdchan, 0, CharBuf, sizeof(CharBuf),
                           0, 0, 0, InAdr);

      if (VMSok (status))
      {
         status = lib$getdvi (&DevNamItem, &clptr->ptdchan,
                              0, 0, &PtdDevNameDsc, &sLength);
         if (VMSok (status))
         {
            clptr->PtdDevName[PtdDevNameDsc.dsc$w_length = sLength] = '\0';
            if ((PrcNamDsc.dsc$w_length = sLength) > 15)
               PrcNamDsc.dsc$w_length = 15;
         }
      }
   }

   /******************/
   /* create process */
   /******************/

   if (VMSok (status))
   {
      /* create a termination mailbox */
      status = sys$crembx (0,
                           &clptr->TermMbxChannel,
                           sizeof(clptr->TermAccount),
                           sizeof(clptr->TermAccount),
                           /* login user termination unknown!! */
                           0x0000,
                           0, 0, CMB$M_READONLY);

      if (VMSok (status))
      {
         /* get the termination mailbox unit number */
         status = lib$getdvi (&UnitItem, &clptr->TermMbxChannel,
                              0, 0, &UnitNumberDsc, &sLength);
         if (VMSok (status))
         {
             UnitNumber[sLength] = '\0';
             clptr->TermMbxUnit = atoi(UnitNumber);
         }
      }

      if (VMSok (status))
      {
         /* queue a read from the termination mailbox */
         status = sys$qio (0, clptr->TermMbxChannel, IO$_READLBLK, 0,
                           PtdCrePrcTerminateAst, clptr,
                           &clptr->TermAccount, sizeof(clptr->TermAccount),
                           0, 0, 0, 0);
      }

#if OPCOM_DBUG
      OpcomMessage ("S/TermMbx !UL %X!8XL !UL",
                    clptr->TermMbxChannel, status, clptr->TermMbxUnit);
#endif

      if (clptr->WatchScript)
         ConsoleCallout (clptr, FI_LI, "TermMbx %d %%X%08.08X |%s| %d",
                         clptr->TermMbxChannel, status,
                         UnitNumber, clptr->TermMbxUnit);
   }

   if (VMSok (status))
   {
      status = sys$creprc (&clptr->ProcessPid,
                           &LoginOutDsc,
                           &PtdDevNameDsc,
                           &PtdDevNameDsc,
                           &PtdDevNameDsc,
                           0, 0,
                           &PrcNamDsc,
                           4,
                           0,
                           clptr->TermMbxUnit,
                           flags,
                           0, 0);


#if OPCOM_DBUG
      OpcomMessage ("S/$creprc() !8XL %X!8XL", clptr->ProcessPid, status);
#endif
   }

   if (clptr->VmsUserName[0])
   {
      /******************/
      /* revert persona */
      /******************/

      ptatus = sys$persona_delete (&PersonaHandle);
      if (VMSnok(ptatus))
         WsLibWatchScript (clptr->WsLibPtr, FI_LI, "$PERSONA_DELETE %X!8XL",
                           ptatus);

      PersonaHandle = ISS$C_ID_NATURAL;

      if (VmsVersionInteger >= 720)
         ptatus = sys$persona_assume (&PersonaHandle, 0, 0, 0);
      else
         ptatus = sys$persona_assume (&PersonaHandle,
                                      IMP$M_ASSUME_SECURITY, 0, 0);
      if (VMSnok (ptatus)) EXIT_FI_LI(ptatus);

      ptatus = sys$setprv (0, &NeedPrvMask, 0, 0);
      if (VMSnok (ptatus)) EXIT_FI_LI(ptatus);
   }

   if (VMSok (status))
   {
#if ACCPORNAM_BUILD
      SetClientAccPorNam (clptr);
#else
      PtdBegin (clptr);
#endif
   }

   return (status);
}

/*****************************************************************************/
/*
This can be called directly from above or from SetClientAccPorNam().
*/

void PtdBegin (struct PtdClient *clptr)

{
   int  status;

   /*********/
   /* begin */
   /*********/

   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI, "PtdTerminateAst() %d %d|%s|",
                      clptr->ptdchan, clptr->AccPorNam[0], clptr->AccPorNam+1);

   status = ptd$set_event_notification (clptr->ptdchan, &PtdXonAst,
                                        clptr, 0, PTD$C_SEND_XON);

   if (VMSok (status))
      status = ptd$set_event_notification (clptr->ptdchan, &PtdXoffAst,
                                           clptr, 0, PTD$C_SEND_XOFF);
#if 0
   if (VMSok (status))
   {
      if (!clptr->VmsUserName[0])
      {
         /* unsolicited input to get LOGINOUT to prompt for username/password */
         clptr->PtdWriteBuffer[sizeof(short)+sizeof(short)] = '\r';
         ptd$write (clptr->ptdchan, 0, 0, clptr->PtdWriteBuffer, 1, 0, 0);
      }
   }
#endif

   if (VMSok (status))
   {
      clptr->PtdQueuedRead++;
      status = ptd$read (0, clptr->ptdchan, &PtdReadAst, clptr,
                         clptr->PtdReadBuffer, sizeof(clptr->PtdReadBuffer));
   }

   if (VMSnok (status)) ptd$delete (clptr->ptdchan);
}

/*****************************************************************************/
/*
Whenever the $CREPRC process terminates this AST is called.  We're not
interested in the accounting data, just that the process is no longer there. 
This eems more reliable than the PTD's terminate AST and not sure exactly why.
Escape character sequence is detected by DCLINABOX.JS. 
*/

void PtdCrePrcTerminateAst (struct PtdClient *clptr)

{
   int  status;

   /*********/
   /* begin */
   /*********/

   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI,
                      "PtdCrePrcTerminateAst() %d %d|%s| %%X%08.08X",
                      clptr->ptdchan, clptr->AccPorNam[0],
                      clptr->AccPorNam+1, 1);

   sys$dassgn (clptr->TermMbxChannel);

   if (clptr->ptdchan) status = ptd$delete (clptr->ptdchan);

   OpcomMessage ("DCLinabox logout !8XL !AZ !AZ",
                 clptr->ProcessPid, clptr->OwnIdent,
                 clptr->AccPorNam + sizeof(AccPorNamPrefix));

#if ACCPORNAM_BUILD
   status = SetAccPorNam (clptr->ptdchan, "");
   memset (clptr->AccPorNam, 0, sizeof(clptr->AccPorNam));
#endif

#if OPCOM_DBUG
   OpcomMessage ("S/PtdCrePrcTerminateAst() !UL/!UL/!UL",
                 AccPorNamCount, AccPorNamSetCount, AccPorNamResetCount);
#endif

   if (clptr->LogoutResponse)
      WsLibWrite (clptr->WsLibPtr, LogoutEscape,
                  sizeof(LogoutEscape)-1, WSLIB_ASYNCH);
   else
      WsLibWrite (clptr->WsLibPtr, TerminateEscape,
                  sizeof(TerminateEscape)-1, WSLIB_ASYNCH);

   /* non-empty acts as a flag indicating a lookup is in progress */
   if (clptr->RemotePort[0])
      clptr->RemotePort[0] = '\0';
   else
      PtdTerminateFree (clptr);
}

/*****************************************************************************/
/*
Free the memory allocated for the client.
*/

void PtdTerminateFree (struct PtdClient *clptr)

{
   int  status;

   /*********/
   /* begin */
   /*********/

   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI, "PtdTerminateFree()");

   status = lib$free_vm_page (&PtdClientPages, &clptr);
   if (VMSnok(status)) EXIT_FI_LI (status);

   if (ConnectedCount) ConnectedCount--;
}

/*****************************************************************************/
/*
Called when the process terminates.
All the real work is performed by PtdCrePrcTerminateAst() because
PtdTerminateAst() does not seem to be called when the WebSocket connection is
[DISCONNECT] and not sure why.
*/

void PtdTerminateAst (struct PtdClient *clptr)

{
   /*********/
   /* begin */
   /*********/

   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI, "PtdTerminateAst() %d %d|%s|",
                      clptr->ptdchan, clptr->AccPorNam[0], clptr->AccPorNam+1);
}

/*****************************************************************************/
/*
Cancel any outstanding terminal I/O.
*/

void PtdClose (struct PtdClient *clptr)

{
   /*********/
   /* begin */
   /*********/

   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI, "PtdClose() %d", clptr->ptdchan);

   if (clptr->PtdQueuedRead || clptr->PtdQueuedWrite)
   {
      ptd$cancel (clptr->ptdchan);
      return;
   }

   WsLibClose (clptr->WsLibPtr, 0 , NULL);
}

/*****************************************************************************/
/*
Data has been read from the PTD (i.e. from the system).
*/

void PtdReadAst (struct PtdClient *clptr)

{
   int  bcnt, status;
   char  *bptr, *cptr, *sptr, *zptr;

   /*********/
   /* begin */
   /*********/

   if (clptr->PtdQueuedRead) clptr->PtdQueuedRead--;

   status = *(short*)clptr->PtdReadBuffer;
   if (VMSok(status))
   {
      bptr = clptr->PtdReadBuffer + sizeof(short)+sizeof(short);
      bcnt = *(short*)(clptr->PtdReadBuffer + sizeof(short));

      if (clptr->SystemHex)
      {
         /* perform hex dump debug */
         zptr = (sptr = clptr->SystemHex) + HEXDUMP_SIZE;
         *sptr++ = '!';
         while (bcnt && sptr < zptr)
         {
            *sptr++ = 'x';
            *sptr++ = HEX_DIGITS[((*bptr & 0xf0) >> 4)];
            *sptr++ = HEX_DIGITS[(*bptr & 0x0f)];
            bptr++;
            bcnt--;
         }
         bptr = clptr->SystemHex;
         bcnt = sptr - clptr->SystemHex;
         /* write this back to the client to be displayed */
         if (clptr->WriteDelay[1])
            WsLibWrite (clptr->WsLibPtr, bptr, bcnt, PtdReadWriteDelay);
         else
            WsLibWrite (clptr->WsLibPtr, bptr, bcnt, PtdReadWriteAst);
         return;
      }

      /*
         Check if it looks like a LOGOUT response.
         e.g. "\r  SYSTEM       logged out at 21-JUL-2012 22:03:31.08\r"
           or "\r  SYSTEM       logged out at 21-JUL-2012 22:03\r"
      */
      if (bcnt == 48 || bcnt == 54)
      {
         zptr = (cptr = bptr) + bcnt;
         if (*cptr == '\r' || *cptr == '\n') cptr++;
         while (cptr < zptr && *cptr == ' ') cptr++;
         while (cptr < zptr && *cptr != ' ') cptr++;
         while (cptr < zptr && *cptr == ' ') cptr++;
         if (cptr == bptr+16 && !strncmp (cptr, "logged out at", 13))
         {
            cptr += 13;
            while (cptr < zptr && *cptr == ' ') cptr++;
            if (cptr < zptr && isdigit(*cptr)) cptr++;
            if (cptr < zptr && isdigit(*cptr)) cptr++;
            if (cptr < zptr && *cptr == '-') cptr++;
            if (cptr < zptr && isalpha(*cptr)) cptr++;
            if (cptr < zptr && isalpha(*cptr)) cptr++;
            if (cptr < zptr && isalpha(*cptr)) cptr++;
            if (cptr < zptr && *cptr == '-') cptr++;
            if (cptr < zptr && isdigit(*cptr)) cptr++;
            if (cptr < zptr && isdigit(*cptr)) cptr++;
            if (cptr < zptr && isdigit(*cptr)) cptr++;
            if (cptr < zptr && isdigit(*cptr)) cptr++;
            while (cptr < zptr && *cptr == ' ') cptr++;
            while (cptr < zptr && (isdigit(*cptr) ||
                                   *cptr == ':' ||
                                   *cptr == '.')) cptr++;
            /* if termination does not happen 'immediately' this gets reset */
            if (cptr == zptr-1 && (*cptr == '\r' || *cptr == '\n'))
               clptr->LogoutResponse = 10;
         }
      }

      /*
         The JavaScript front-end destroys the credentials once supplied and
         so subsequent matching strings in output may trigger the escape
         sequences but the front-end will not have a corresponding string to
         respond with, meaning a one-shot mechanism is not required here.
      */
      if (bcnt == 12)      
         if (!memcmp (bptr, "\n\rUsername: ", 12))
            WsLibWrite (clptr->WsLibPtr, UsernameEscape,
                        sizeof(UsernameEscape)-1, WSLIB_ASYNCH);
      if (bcnt == 11)
         if (!memcmp (bptr, "\rPassword: ", 11))
            WsLibWrite (clptr->WsLibPtr, PasswordEscape,
                        sizeof(PasswordEscape)-1, WSLIB_ASYNCH);

      if (clptr->WriteDelay[1])
         WsLibWrite (clptr->WsLibPtr, bptr, bcnt, PtdReadWriteDelay);
      else
         WsLibWrite (clptr->WsLibPtr, bptr, bcnt, PtdReadWriteAst);
   }
   else
   {
      if (clptr->WatchScript)
         ConsoleCallout (clptr, FI_LI, "PtdReadAst() %d %%X%08.08X",
                         clptr->ptdchan, *(short*)clptr->PtdReadBuffer);
      PtdClose (clptr);
   }
}

/*****************************************************************************/
/*
Introduce the specified delay to the writing of any PTD data to the JavaScript
emulator.  This is a development capability for when the processing of terminal
data needs to be slowed down for observation.
*/

void PtdReadWriteDelay (struct WsLibStruct *wsptr)

{
   int  status;
   struct PtdClient  *clptr;

   /*********/
   /* begin */
   /*********/

   /* wsLIB clears the status once the AST is delivered so buffer */ 
   clptr = WsLibGetUserData(wsptr);
   clptr->WriteDelayStatus = WsLibWriteStatus(wsptr);

   status = sys$setimr (0, &clptr->WriteDelay, PtdReadWriteAst, wsptr, 0);
   if (VMSnok(status)) EXIT_FI_LI (status);
}

/*****************************************************************************/
/*
Data read from the PTD (system) has been written to the WebSocket client. 
Check status and if OK queue another read from the PTD.
*/

void PtdReadWriteAst (struct WsLibStruct *wsptr)

{
   int  status;
   struct PtdClient  *clptr;

   /*********/
   /* begin */
   /*********/

   clptr = WsLibGetUserData(wsptr);

   status = WsLibWriteStatus (wsptr);
   /* if cleared status then use the delayed buffer value */
   if (!status) status = clptr->WriteDelayStatus;

   if (VMSok (status))
   {
      clptr->PtdQueuedRead++;
      ptd$read (0, clptr->ptdchan, &PtdReadAst, clptr,
                clptr->PtdReadBuffer,
                sizeof(clptr->PtdReadBuffer)-sizeof(short)-sizeof(short));
   }
   else
   {
      if (clptr->WatchScript)
         ConsoleCallout (clptr, FI_LI, "PtdReadWriteAst() %d %%X%08.08X",
                         clptr->ptdchan, status);
      WsLibClose (wsptr, 0, NULL);
   }
}

/*****************************************************************************/
/*
Asynchronous read from a WebSocket client has concluded.
*/

void PtdReadClient (struct WsLibStruct *wsptr)

{
   int  bcnt, cnt;
   char  *bptr, *cptr, *sptr, *zptr;
   struct PtdClient  *clptr;

   /*********/
   /* begin */
   /*********/

   clptr = WsLibGetUserData(wsptr);

   if (VMSnok (WsLibReadStatus(wsptr)))
   {
      /* WEBSOCKET_INPUT read error (can be EOF) */
      if (clptr->WatchScript)
         ConsoleCallout (clptr, FI_LI, "PtdReadClient() %d %%X%08.08X",
                         clptr->ptdchan, WsLibReadStatus(wsptr));
      WsLibClose (wsptr, 0, NULL);
      return;
   }

   /* use data from the dynamic buffer available during the AST */
   if (bcnt = cnt = WsLibReadCount(wsptr))
   {
      if (!(bptr = cptr = WsLibReadData (wsptr)))
      {
         WsLibClose (wsptr, 0, NULL);
         return;
      }

      /* is it a DCLinabox escape sequence */
      if (bcnt >= sizeof(DCLinaboxEscape)-1 &&
          *(ulong*)bptr == DCLINABOX_ESCAPE4 &&
         !memcmp (bptr, DCLinaboxEscape, sizeof(DCLinaboxEscape)-1))
      {
         ClientEscape (clptr, bptr, bcnt);
         WsLibRead (wsptr, NULL, 0, PtdReadClient);
      }
      else
         PtdWrite (clptr, bptr, bcnt);

      /* keep track of client input (for idle timeout) */
      clptr->ClientCount++;

      /* reset on continued client (keyboard) input */
      if (clptr->LogoutResponse) clptr->LogoutResponse--;
   }
}

/*****************************************************************************/
/*
Write the supplied data to the PTD (i.e. to the system).  Generally this will
be keystroke-by-keystroke but if the paste portal is used there will be an
influx of slabs of data, potentially tens or hundreds of kbytes.  So we need
flow control.  Such big slabs will necessarily and effectively block real
keyboard input.  Consider only <CR> to be end-of-line and try to convert what
might be equivalent sequences.
*/

void PtdWrite
(
struct PtdClient *clptr,
char *DataPtr,
int DataCount
)
{
   int  cnt, status;
   char  *bptr, *cptr, *sptr, *zptr;

   /*********/
   /* begin */
   /*********/

   cptr = clptr->WritePtr = DataPtr;
   cnt = clptr->WriteCount = DataCount;

   sptr = bptr = clptr->PtdWriteBuffer + sizeof(short)+sizeof(short);
   zptr = sptr + sizeof(clptr->PtdWriteBuffer) - sizeof(short)-sizeof(short);

   while (cnt && sptr < zptr)
   {
      if (cnt >= 2 && *cptr == '\r' && *(cptr+1) == '\n')
      {
         *sptr++ = *cptr++;
         cptr++;
         cnt -= 2;
         continue;
      }
      if (*cptr == '\n')
      {
         *sptr++ = '\r';
         cptr++;
         cnt--;
         continue;
      }
      *sptr++ = *cptr++;
      cnt--;
   }
   clptr->PtdWriteCount = sptr - bptr;

   clptr->PtdQueuedWrite++;
   ptd$write (clptr->ptdchan, PtdWriteAst, clptr,
              clptr->PtdWriteBuffer, clptr->PtdWriteCount, 0, 0);
}

/*****************************************************************************/
/*
PTD write (to system) has completed.  If OK continue with remaining data or
read from the WebSocket client.
*/

void PtdWriteAst (struct PtdClient *clptr)

{
   int  cnt, status;

   /*********/
   /* begin */
   /*********/

   if (clptr->PtdQueuedWrite) clptr->PtdQueuedWrite--;

   status = *(short*)clptr->PtdWriteBuffer;
   cnt = *(short*)(clptr->PtdWriteBuffer+sizeof(short));

   /* adjust buffer window according to actual write */
   clptr->WritePtr += cnt;
   clptr->WriteCount -= cnt;

   if (VMSok(status) ||
       status == SS$_DATAOVERUN ||
       status == SS$_DATALOST)
   {
      if (status == SS$_DATAOVERUN)
         WsLibWatchScript (clptr->WsLibPtr, FI_LI, "DATAOVERUN");
      else
      if (status == SS$_DATALOST)
      {
         WsLibWatchScript (clptr->WsLibPtr, FI_LI, "DATALOST");
         /* not much point continuing with this */
         clptr->WriteCount = 0;
      }

      if (clptr->XoffRx) return;

      if (clptr->WriteCount)
         PtdWrite (clptr, clptr->WritePtr, clptr->WriteCount);
      else
         WsLibRead (clptr->WsLibPtr, NULL, 0, PtdReadClient);
   }
   else
   {
      if (clptr->WatchScript)
         ConsoleCallout (clptr, FI_LI, "PtdWriteAst() %d %%X%08.08X",
                         clptr->ptdchan, *(short*)clptr->PtdWriteBuffer);
      PtdClose (clptr);
   }
}

/*****************************************************************************/
/*
Flow control - stop/suspend data writes.
*/

void PtdXoffAst (struct PtdClient *clptr)

{
   /*********/
   /* begin */
   /*********/

   WsLibWatchScript (clptr->WsLibPtr, FI_LI, "XOFF");

   clptr->XoffRx = 1;
}

/*****************************************************************************/
/*
Flow control - start/resume data writes.
*/

void PtdXonAst (struct PtdClient *clptr)

{
   /*********/
   /* begin */
   /*********/

   WsLibWatchScript (clptr->WsLibPtr, FI_LI, "XON");

   /* ignore anything out-of-order */
   if (!clptr->XoffRx) return;

   clptr->XoffRx = 0;

   if (clptr->WriteCount)
      PtdWrite (clptr, clptr->WritePtr, clptr->WriteCount);
   else
      WsLibRead (clptr->WsLibPtr, NULL, 0, PtdReadClient);
}

/*****************************************************************************/
/*
Client has sent a DCLinabox escape sequence.
*/

void ClientEscape
(
struct PtdClient *clptr,
char *DataPtr,
int DataCount
)
{
   unsigned int  cols, rows, mSec;
   char  *cptr, *zptr;

   /*********/
   /* begin */
   /*********/

   zptr = (cptr = DataPtr) + DataCount;
   if (!memcmp (cptr, TermSizeEscape, sizeof(TermSizeEscape)-1))
   {
      /* resize terminal sequence */
      cols = rows = -1;
      cptr += sizeof(TermSizeEscape)-1;
      cols = atoi(cptr);
      while (isdigit(*cptr) && cptr < zptr) cptr++;
      if (*cptr == 'x') cptr++;
      rows = atoi(cptr);
      while (isdigit(*cptr) && cptr < zptr) cptr++;
      if (*cptr) cols = rows = -1;
      if (cols < 48 || cols > 511) cols = (unsigned int)-1;
      if (rows < 10 || rows > 255) rows = (unsigned int)-1;

      ptd$decterm_set_page_size (clptr->ptdchan, rows, cols);

      AdviseClientTermSize (clptr);
   }
   else
   if (!memcmp (cptr, DelayEscape, sizeof(DelayEscape)-1))
   {
      /* non-zero to enable, zero to disable */
      cptr += sizeof(DelayEscape)-1;
      mSec = atoi(cptr);
      if (mSec)
      {
         if (mSec > 10000) mSec = 10000;
         clptr->WriteDelay[0] = -1000;
         clptr->WriteDelay[1] = -1;
         lib$mult_delta_time (&mSec, &clptr->WriteDelay);
      }
      else
         clptr->WriteDelay[0] = clptr->WriteDelay[1] = 0;
   }
}

/*****************************************************************************/
/*
GETDVI the terminal width and height and advise the client using the
appropriate DCLinabox escape sequence.
*/

void AdviseClientTermSize (struct PtdClient *clptr)

{
   static unsigned long  DevBufSizItem = DVI$_DEVBUFSIZ,
                         TtPageItem = DVI$_TT_PAGE;

   int  cnt;
   unsigned long  DevBufSiz,
                  TtPage;
   char  *cptr, *sptr, *zptr;
   char  TermSize [sizeof(TermSizeEscape)+32];

   /*********/
   /* begin */
   /*********/

   lib$getdvi (&TtPageItem, &clptr->ptdchan, 0, &TtPage, 0, 0);
   lib$getdvi (&DevBufSizItem, &clptr->ptdchan, 0, &DevBufSiz, 0, 0);

   zptr = (sptr = TermSize) + sizeof(TermSize)-32;
   for (cptr = TermSizeEscape; *cptr && sptr < zptr; *sptr++ = *cptr++);
   sptr += sprintf (sptr, "%dx%d", DevBufSiz, TtPage);

   WsLibWrite (clptr->WsLibPtr, TermSize, sptr-TermSize, WSLIB_ASYNCH);
}

/*****************************************************************************/
/*
Logical name value DCLINABOX_ENABLE controls whether this script can be used. 
Make the value "*" to allow all remote hosts.  Alternatively provide one or
more comma-separated, dotted-decimal IP address to specify one or more hosts
allowed to use the script, and/or one or more comman-separated IP addresses and
CIDR subnet mask to specify a range of hosts.  IPv4 only!
*/

int DCLinaboxEnable ()

{
   unsigned int  IPaddr, IPnet, mask;
   char  ch;
   char  *aptr, *cptr, *sptr, *zptr;

   /*********/
   /* begin */
   /*********/

   if (!(cptr = SysTrnLnm (EnableLogicalName, NULL, 0)))
   {
      fprintf (stdout, "Status: 403 \"%s\" undefined\r\n\r\n",
               EnableLogicalName);
      exit (1);
   }

   if (!(aptr = WsLibCgiVarNull("REMOTE_ADDR"))) return (0);
   /* inet_aton() is not available on VMS V7.2 */
   IPaddr = inet_addr (aptr);
   if (IPaddr == 0xffffffff) return (0);

   if (!strstr (cptr, "ws:"))
   {
      if (!(sptr = WsLibCgiVarNull ("REQUEST_SCHEME"))) return (0);
      if (strcmp(sptr,"wss:") && strcmp(sptr,"https:"))
      {
         fprintf (stdout, "Status: 403 Must be SSL\r\n\r\n");
         return (0);
      }
   }

   if (strchr (cptr, '*')) return (1);

   while (*cptr && *sptr)
   {
      while (*cptr && *cptr != ',') cptr++;
      if (ch = *cptr) *cptr = '\0';
      if (zptr = strchr (sptr, '/'))
      {
         /* subnet mask */
         *zptr = '\0';
         /* inet_aton() is not available on VMS V7.2 */
         IPnet = inet_addr (sptr);
         if (IPnet == 0xffffffff) return (0);
         mask = atoi(zptr+1);
         mask = 0xffffffff >> (32 - mask); 
         /* if both addresses are valid and masked client address matches */
         if (IPaddr && IPnet && (IPnet == (IPaddr & mask))) return (1);
         *zptr = '/';
      }
      else
      if (!strcmp (sptr, aptr))
         return (1);
      if (*cptr = ch) cptr++;
      sptr = cptr;
   }

   fprintf (stdout, "Status: 403 Not Permitted\r\n\r\n");

   return (0);
}

/*****************************************************************************/
/*
See description in code prologue.  Returns SS$_NORMAL if single sign-on has
been validated and should be performed, SS$_NOMOREITEMS (still a success
status) if DCLinabox without SSO is permitted, and SS$_INVLOGIN if DCLinabox
usage is not permitted without SSO.
*/

int DCLinaboxSingleSignOn (struct PtdClient *clptr)

{
   static unsigned long  SysPrvMask [2] = { PRV$M_SYSPRV, 0 };
   static unsigned long  UaiFlags;
   static unsigned long  UaiPriv [2];
   static struct {
      short int  buf_len;
      short int  item;
      void  *buf_addr;
      unsigned short  *ret_len;
   } UaiItems [] =
   {
      { sizeof(UaiFlags), UAI$_FLAGS, &UaiFlags, 0 },
      { sizeof(UaiPriv), UAI$_PRIV, &UaiPriv, 0 },
      { 0,0,0,0 }
   };
   static $DESCRIPTOR (UserNameDsc, "");

   int  idx, ptatus, status,
        NotUserName = 0;
   char  *cptr, *sptr, *zptr,
         *AuthRealm,
         *RemoteUser;
   struct WsLibStruct  *wsptr;

   /*********/
   /* begin */
   /*********/

   if (WsLibCgiVarNull("WWW_PAPI_ASSERT"))
   {
      /* PAPI SSO environment */
      if (!(AuthRealm = WsLibCgiVarNull("WWW_PAPI_CN")))
         return (SS$_NOMOREITEMS);
      while (*AuthRealm && *AuthRealm != '@') AuthRealm++;
      if (*AuthRealm) AuthRealm++;
      if (!*AuthRealm) return (SS$_NOMOREITEMS);
   }
   else
   {
      if (!(AuthRealm = WsLibCgiVarNull("WWW_AUTH_REALM")))
         return (SS$_NOMOREITEMS);
      if (!*AuthRealm) return (SS$_NOMOREITEMS);
   }

   if (!(RemoteUser = WsLibCgiVarNull("WWW_REMOTE_USER")))
      return (SS$_NOMOREITEMS);
   if (!*RemoteUser) return (SS$_NOMOREITEMS);

   UserNameDsc.dsc$a_pointer = RemoteUser;
   UserNameDsc.dsc$w_length = strlen(RemoteUser);

   wsptr = clptr->WsLibPtr;

   for (idx = 0; idx <= 127; idx++)
   {
      if (!(cptr = SysTrnLnm (SingleLogicalName, NULL, idx))) break;

      WsLibWatchScript (wsptr, FI_LI, "\"!AZ\"", cptr);
      for (sptr = cptr; *sptr && *sptr != '='; sptr++);
      if (*sptr) *sptr++ = '\0';

      /* if the realm name does not match then look for the next */
      WsLibWatchScript (wsptr, FI_LI, "\"!AZ\" \"!AZ\"", AuthRealm, cptr);
      if (!*cptr || strcasecmp (cptr, AuthRealm)) continue;

      while (*cptr)
      {
         for (cptr = sptr; *sptr && *sptr != ','; sptr++);
         if (!*cptr) break;
         if (*sptr) *sptr++ = '\0';
         if (!*cptr) continue;

         WsLibWatchScript (wsptr, FI_LI, "\"!AZ\" \"!AZ\"", RemoteUser, cptr);

         if (*cptr == '!') cptr++;

         if (strcasecmp (cptr, RemoteUser) && *cptr != '*') continue;

         /* check the account status */
         ptatus = sys$setprv (1, &SysPrvMask, 0, 0);
         if (VMSnok (ptatus)) EXIT_FI_LI(ptatus);

         status = sys$getuai (0, 0, &UserNameDsc, &UaiItems, 0, 0, 0);

         ptatus = sys$setprv (0, &SysPrvMask, 0, 0);
         if (VMSnok (ptatus)) EXIT_FI_LI(ptatus);

         if (VMSnok (status))
         {
            WsLibWatchScript (wsptr, FI_LI, "$GETUAI %X!8XL", status);
            return (SS$_NOMOREITEMS);
         }

         if (UaiFlags & UAI$M_DISACNT)
         {
            WsLibWatchScript (wsptr, FI_LI, "UAI flags !8XL", UaiFlags);
            return (SS$_NOMOREITEMS);
         }

         /* wildcard match (allows privileged) */
         if (*(USHORTPTR)cptr == '**') break;

         /* if the user name matches */
         if (!strcasecmp (cptr, RemoteUser))
         {
            if (*(cptr-1) == '!')
            {
               NotUserName = 1;
               continue;
            }
            NotUserName = 0;
            break;
         }

         /* check for vanilla user */
         if ((UaiPriv[0] & ~(PRV$M_NETMBX | PRV$M_TMPMBX)) || UaiPriv[1])
         {
            WsLibWatchScript (wsptr, FI_LI, "UAI priv !8XL !8XL",
                              UaiPriv[0], UaiPriv[1]);
            return (SS$_NOMOREITEMS);
         }

         break;
      }

      if (*cptr) break;
   }

   if (cptr && *cptr && *(cptr-1) != '!' && !NotUserName)
   {
      zptr = (sptr = clptr->VmsUserName) + sizeof(clptr->VmsUserName)-1;
      for (cptr = RemoteUser; *cptr && sptr < zptr; *sptr++ = *cptr++);
      if (sptr > zptr)
      {
         /* hmmm, something's askew! */
         clptr->VmsUserName[0] = '\0';
         return (SS$_RESULTOVF);
      }
      *sptr = '\0';
      return (SS$_NORMAL);
   }

   if (cptr && *(USHORTPTR)(cptr-1) == '!*')
   {
      /* only available to SSO */
      return (SS$_INVLOGIN);
   }

   return (SS$_NOMOREITEMS);
}

/*****************************************************************************/
/*
Timer-driven function, called once every ten seconds to 1) set the title of
any new terminal window(s) and any idle timeout, 2) every minute check the
process name associated with the terminal and reset the title if necessary (if
INSTALLed with WORLD privilege), and 3) manage idle terminals (if configured).
*/

void SessionManagement ()

{
   /* fifteen seconds */
   static unsigned long  TimerDelta [2] = { -100000000, -1 };
   static unsigned long  WorldMask [2] = { PRV$M_WORLD, 0 };
   static unsigned long  DviOwnUic,
                         DviPid;
   static int  AlertMsgLen,
               HasWorld = 1,
               IdleMins,
               PrevMin,
               WarnMins;
   static unsigned short  DviHostNameLen,
                          JpiPrcNamLen;
   static char  *WarnMsgPtr;
   static char  AlertMsg [sizeof(AlertEscape)+256],
                DviDevNam [64+1],
                DviHostName [8+1],
                IdleLogicalValue [256],
                IdentString [64],
                JpiPrcNam [15+1];
   static $DESCRIPTOR (UicFaoDsc, "!%I\0");
   static $DESCRIPTOR (IdentStringDsc, IdentString);
   static struct {
      short int  buf_len;
      short int  item;
      void  *buf_addr;
      unsigned short  *ret_len;
   }
   DviItems [] =
   {
      { sizeof(DviPid), DVI$_PID, &DviPid, 0 },
      { sizeof(DviOwnUic), DVI$_OWNUIC, &DviOwnUic, 0 },
      { sizeof(DviHostName), DVI$_HOST_NAME, &DviHostName, &DviHostNameLen },
      { 0,0,0,0 }
   },
   JpiItems [] =
   {
      { sizeof(JpiPrcNam)-1, JPI$_PRCNAM, &JpiPrcNam, &JpiPrcNamLen },
      { 0,0,0,0 }
   };

   int  len, ptatus, status,
        NewTitle,
        Time32;
   int64  Time64;
   unsigned short  NumTime[7];
   char  *aptr, *cptr, *sptr, *zptr;
   char  EscapeBuffer [sizeof(DCLinaboxEscape)+256+16];
   struct PtdClient  *clptr;
   struct WsLibStruct  *wsptr = NULL; 

   /*********/
   /* begin */
   /*********/

   sys$gettim (&Time64);
   Time32 = decc$fix_time (&Time64);
   sys$numtim (&NumTime, &Time64);

   if (NumTime[4] != PrevMin)
   {
      /****************/
      /* every minute */
      /****************/

      /* idle session management can be changed at any point */
      IdleMins = WarnMins = 0;
      WarnMsgPtr = NULL;

      if (cptr = SysTrnLnm (IdleLogicalName, IdleLogicalValue, 0))
      {
         IdleMins = atoi(cptr);
         while (*cptr && *cptr != ',') cptr++;
         if (*cptr) cptr++;
         WarnMins = atoi(cptr);
         while (*cptr && *cptr != ',') cptr++;
         if (*cptr) cptr++;
         if (!*(WarnMsgPtr = cptr)) WarnMsgPtr = DEFAULT_WARN_MESSAGE;
      }
      /* defining idle minutes to -1 disables idle session management */
      if (IdleMins >= 0)
      {
         if (!IdleMins) IdleMins = DEFAULT_IDLE_MINS;
         if (!WarnMins) WarnMins = DEFAULT_WARN_MINS;
         if (IdleMins <= WarnMins) IdleMins = WarnMins + DEFAULT_WARN_MINS;
         if (!WarnMsgPtr) WarnMsgPtr = DEFAULT_WARN_MESSAGE;
      }

      /* check for the presence of an ALERT logical name and value */
      if (aptr = SysTrnLnm (AlertLogicalName, NULL, 0))
      {
         if (!AlertMsg[0] || strcmp (aptr, AlertMsg+sizeof(AlertEscape)-1))
         {
            /* value has been defined/changed since last time */
            while (WsLibNext(&wsptr))
            {
               /* if not a new session reset alerted flag */
               clptr = WsLibGetUserData(wsptr);
               if (clptr->DviOwnUic) clptr->Alerted = 0;
            }
            zptr = (sptr = AlertMsg) + sizeof(AlertMsg)-1;
            for (cptr = AlertEscape; *cptr && sptr < zptr; *sptr++ = *cptr++);
            while (*aptr && sptr < zptr) *sptr++ = *aptr++;
            *sptr = '\0';
            AlertMsgLen = sptr - AlertMsg;
         }
      }
      else
         AlertMsg[0] = '\0';
   }

   /****************/
   /* all sessions */
   /****************/

   while (WsLibNext(&wsptr))
   {
      clptr = WsLibGetUserData(wsptr);

      if (!clptr->DviOwnUic)
      {
         /***************/
         /* new session */
         /***************/

         status = sys$getdviw (0, clptr->ptdchan, 0, &DviItems, 0, 0, 0, 0, 0);
         if (VMSnok (status)) continue;

         /* for a LOGINOUT terminal, ownership is changed after login */
         if (DviOwnUic == ScriptUic) continue;

         /* provoke as an immediate title change as we can */
         PrevMin = -1;

         clptr->DviOwnUic = DviOwnUic;
         clptr->DviPid = DviPid;
         DviHostName[DviHostNameLen] = '\0';
         strcpy (clptr->DviHostName, DviHostName);

         sys$fao (&UicFaoDsc, 0, &IdentStringDsc, clptr->DviOwnUic);
         zptr = (sptr = clptr->OwnIdent) + sizeof(clptr->OwnIdent)-1;
         if (strchr (IdentString, ','))
            for (cptr = IdentString; *cptr && sptr < zptr; *sptr++ = *cptr++);
         else
         {
            /* strip the [] from the identifier */
            if (*(cptr = IdentString) == '[') cptr++;
            while (*cptr && *cptr != ']' && sptr < zptr) *sptr++ = *cptr++;
         }
         *sptr = '\0';

         OpcomMessage ("DCLinabox login !8XL !AZ !AZ",
                       clptr->ProcessPid, clptr->OwnIdent,
                       clptr->AccPorNam + sizeof(AccPorNamPrefix));
      }

      /*****************/
      /* session title */
      /*****************/

      if (NumTime[4] != PrevMin)
      {
         JpiPrcNam[0] = '\0';
         if (HasWorld)
         {
            ptatus = sys$setprv (1, &WorldMask, 0, 0);
            if (VMSnok (ptatus)) EXIT_FI_LI(ptatus);
            if (ptatus == SS$_NOTALLPRIV) HasWorld = 0;
         }

         if (HasWorld)
         {
            status = sys$getjpiw (0, &clptr->ProcessPid, 0, &JpiItems, 0, 0, 0);

            ptatus = sys$setprv (0, &WorldMask, 0, 0);
            if (VMSnok (ptatus)) EXIT_FI_LI(ptatus);

            if (VMSok(status)) JpiPrcNam[JpiPrcNamLen] = '\0';
         }

         if (JpiPrcNam[0] && strcasecmp (JpiPrcNam, clptr->JpiPrcNam))
         {
            strcpy (clptr->JpiPrcNam, JpiPrcNam);
            len = snprintf (EscapeBuffer, sizeof(EscapeBuffer),
                            "%sDCLinabox: %s %s::%s%s%s%s",
                            TitleEscape, clptr->HttpHost, DviHostName,
                            clptr->OwnIdent,
                            clptr->JpiPrcNam[0] ? " \"" : "",
                            clptr->JpiPrcNam,
                            clptr->JpiPrcNam[0] ? "\"" : "");
            if (len > 0) WsLibWrite (wsptr, EscapeBuffer, len, WSLIB_ASYNCH);
         }
      }

      /****************/
      /* idle session */
      /****************/

      if (IdleMins != clptr->IdleMins ||
          WarnMins != clptr->WarnMins)
      {
         /* (re)set and (re)calculate */
         clptr->IdleMins = IdleMins;
         clptr->WarnMins = WarnMins;
         if (IdleMins > 0)
         {
            clptr->IdleTime = Time32 + (clptr->IdleMins * 60);
            clptr->WarnTime = clptr->IdleTime - (clptr->WarnMins * 60);
            clptr->IdleCount = clptr->ClientCount;
         }
         else
           clptr->IdleTime = clptr->WarnTime = 0;
      }
      else
      if (clptr->IdleTime && clptr->ClientCount > clptr->IdleCount)
      {
         /* there has been client input since last time - reset timeout */
         clptr->IdleCount = clptr->ClientCount;
         clptr->IdleTime = Time32 + (clptr->IdleMins * 60);
         clptr->WarnTime = clptr->IdleTime - (clptr->WarnMins * 60);
      }
      else
      if (clptr->IdleTime && clptr->IdleTime < Time32)
      {
         clptr->IdleTime = clptr->WarnTime = 0;
         clptr->Alerted = 1;
         WsLibClose (wsptr, 0, NULL);

         /* avoid trying to bang out an alert message after closure */
         continue;
      }
      else
      if (clptr->WarnTime && clptr->WarnTime < Time32)
      {
         clptr->WarnTime = 0;
         zptr = (sptr = EscapeBuffer) + sizeof(EscapeBuffer)-16;
         for (cptr = AlertEscape; *cptr && sptr < zptr; *sptr++ = *cptr++);
         for (cptr = WarnMsgPtr;
              *cptr && *(USHORTPTR)cptr != '%d' && sptr < zptr;
              *sptr++ = *cptr++);
         if (*(USHORTPTR)cptr == '%d')
         {
            cptr += 2;
            sprintf (sptr, "%d", WarnMins);
            while (*sptr && sptr < zptr) sptr++;
            while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         }
         WsLibWrite (wsptr, EscapeBuffer, sptr-EscapeBuffer, WSLIB_ASYNCH);

         /* avoid banging out an alert message at the same time */
         continue;
      }

      /*****************/
      /* alert message */
      /*****************/

      if (AlertMsg[0] && !clptr->Alerted)
      {
         clptr->Alerted = 1;
         WsLibWrite (clptr->WsLibPtr, AlertMsg, AlertMsgLen, WSLIB_ASYNCH);
      }

      /**************/
      /* keep-alive */
      /**************/

      /* every minute send a keep-alive to (help) prevent proxy disconnect */
      if (NumTime[4] != PrevMin)
         WsLibWrite (clptr->WsLibPtr, KeepAliveEscape,
                     sizeof(KeepAliveEscape)-1, WSLIB_ASYNCH);
   }

   PrevMin = NumTime[4];

   status = sys$setimr (0, &TimerDelta, SessionManagement, 0, 0);
   if (VMSnok(status)) EXIT_FI_LI (status);
}

/*****************************************************************************/
/*
Provide [X]DCL + [X]Script WATCHable data exactly inside the data stream to and
from the JavaScript.
*/

void ConsoleCallout
(
struct PtdClient *clptr,
char* module,
int line,
char *fmt,
...
)
{
   char buf [256];
   char  *sptr;
   va_list  ap;

//   if (!clptr->WatchScript) return;

   sptr = buf;
   /* add an explicit UTF-8 character to force WSLib to buffer the data */
   sptr += sprintf (sptr, "%s%c%s:%d ", ConsoleEscape, 0xd7, module, line);
   va_start (ap, fmt);
   sptr += vsprintf (sptr, fmt, ap);
   va_end (ap);
   if (sptr-buf >= sizeof(buf)) EXIT_FI_LI (SS$_BUGCHECK);

   WsLibWrite (clptr->WsLibPtr, buf, sptr-buf, WSLIB_ASYNCH);
}

/*****************************************************************************/
/*
Provide a callout to the server.  Must be a '!' (no response callout).
*/
void ScriptCallout (char *fmt, ...)

{
   int  retval;
   va_list  ap;

   /* must be received as records */
   fflush (stdout);
   fprintf (stdout, "%s\n", SysTrnLnm("CGIPLUSESC", NULL, 0));
   fflush (stdout);

   va_start (ap, fmt);
   retval = vfprintf (stdout, fmt, ap);
   va_end (ap);

   fflush (stdout);
   fprintf (stdout, "%s\n", SysTrnLnm("CGIPLUSEOT", NULL, 0));
   fflush (stdout);
}

/****************************************************************************/
/*
Getting developer information out of this application can sometimes be a royal
PITA.  $FAO formatted print statement to OPCOM.  A fixed-size, internal buffer
of 986 bytes maximum is used and the result output as an OPCOM message.  If the
format string begins with "S/" it is sent to SOFTWARE, otherwise CENTRAL. 
*/

void OpcomMessage
(
char *FormatString,
...
)
{
   static $DESCRIPTOR (FaoDsc, "");
   static $DESCRIPTOR (OpcomDsc, "");
   static $DESCRIPTOR (OpcomMsgDsc, "");

   int  status, argcnt, target;
   unsigned short  ShortLength;
   unsigned long  *vecptr;
   unsigned long  FaoVector [31+1];
   va_list  argptr;
   struct
   {
      unsigned long  TargetType;
      unsigned long  RequestId;
      char  MsgText [986+1];
   } OpcomMsg;

   /*********/
   /* begin */
   /*********/

   va_count (argcnt);

   if (dbug)
      fprintf (stdout, "OpcomMessage() |%s| %d\n", FormatString, argcnt);

   if (argcnt > 31+1) exit (SS$_OVRMAXARG);

   vecptr = FaoVector;
   va_start (argptr, FormatString);
   for (argcnt -= 1; argcnt; argcnt--)
      *vecptr++ = va_arg (argptr, unsigned long);
   va_end (argptr);
   *vecptr = 0;

   if (*(USHORTPTR)FormatString == 'S/')
   {
      target = OPC$M_NM_SOFTWARE;
      FormatString += 2;
   }
   else
      target = OPC$M_NM_CENTRL;
   FaoDsc.dsc$a_pointer = FormatString;
   FaoDsc.dsc$w_length = strlen(FormatString);

   OpcomMsgDsc.dsc$a_pointer = (char*)&OpcomMsg.MsgText;
   OpcomMsgDsc.dsc$w_length = sizeof(OpcomMsg.MsgText)-1;

   status = sys$faol (&FaoDsc, &ShortLength, &OpcomMsgDsc, &FaoVector);
   if (VMSnok (status)) EXIT_FI_LI(status);

   OpcomMsg.MsgText[ShortLength] = '\0';
   if (dbug) fprintf (stdout, "%d |%s|\n", ShortLength, OpcomMsg.MsgText);

   OpcomMsg.TargetType = OPC$_RQ_RQST + ((target & 0xffffff) << 8);
   OpcomMsg.RequestId = 0;

   OpcomDsc.dsc$a_pointer = (char*)&OpcomMsg;
   OpcomDsc.dsc$w_length = ShortLength + 8;

   status = sys$sndopr (&OpcomDsc, 0);
   if (VMSnok (status)) EXIT_FI_LI(status);
}

/*****************************************************************************/
/*
Return true or false depending on whether the server is an equal or later
release to the supplied version string.
*/

int MinimumWASD (char *vstring)

{
   int  major[2], minor[2], tweak[2];
   char  *cptr;

   /*********/
   /* begin */
   /*********/

   if (dbug) fprintf (stdout, "MinimumWASD() %s\n", vstring);

   major[0] = minor[0] = tweak[0] = major[1] = minor[1] = tweak[1] = 0;

   if (sscanf (vstring, "%d.%d.%d", &major[0], &minor[0], &tweak[0]) < 3)
      return (0);
   if (!(cptr = strstr (WsLibCgiVar("SERVER_SOFTWARE"), "WASD/")))
      return (0);
   if (sscanf (cptr+5, "%d.%d.%d", &major[1], &minor[1], &tweak[1]) < 3)
      return (0);

   if (major[1] > major[0]) return (1);
   if (major[1] == major[0])
   {
      if (minor[1] > minor[0]) return (1);
      if (minor[1] == minor[0] && tweak[1] >= tweak[0]) return (1);
   }

   return (0);
}

/*****************************************************************************/
/*
Translate a logical name using LNM$FILE_DEV.  Returns a pointer to the value
string, or NULL if the name does not exist.  If 'LogValue' is supplied the
logical name is translated into that (assumed to be large enough), otherwise
it's translated into an internal static buffer.  'IndexValue' should be zero
for a 'flat' logical name, or 0..127 for interative translations.
*/

char* SysTrnLnm
(
char *LogName,
char *LogValue,
int IndexValue
)
{
   static unsigned short  ValueLength;
   static unsigned long  LnmAttributes,
                         LnmIndex;
   static char  StaticLogValue [256];
   static $DESCRIPTOR (LogNameDsc, "");
   static $DESCRIPTOR (LnmTableDsc, "LNM$FILE_DEV");
   static struct {
      short int  buf_len;
      short int  item;
      void  *buf_addr;
      unsigned short  *ret_len;
   } LnmItems [] =
   {
      { sizeof(LnmIndex), LNM$_INDEX, &LnmIndex, 0 },
      { sizeof(LnmAttributes), LNM$_ATTRIBUTES, &LnmAttributes, 0 },
      { 255, LNM$_STRING, 0, &ValueLength },
      { 0,0,0,0 }
   };

   int  status;
   char  *cptr;

   /*********/
   /* begin */
   /*********/

   LnmIndex = IndexValue;

   LogNameDsc.dsc$a_pointer = LogName;
   LogNameDsc.dsc$w_length = strlen(LogName);
   if (LogValue)
      cptr = LnmItems[2].buf_addr = LogValue;
   else
      cptr = LnmItems[2].buf_addr = StaticLogValue;

   status = sys$trnlnm (0, &LnmTableDsc, &LogNameDsc, 0, &LnmItems);
   if (!(status & 1) || !(LnmAttributes & LNM$M_EXISTS))
   {
      if (LogValue) LogValue[0] = '\0';
      return (NULL);
   }

   cptr[ValueLength] = '\0';
   return (cptr);
}

/*****************************************************************************/
/*
Get the IP name using asynchronous address-to-name lookup.  Despite the implied
IPv6 functionality TCP/IP Services lookup only supports IPv4 (sigh, one day
perhaps).  When initiating a lookup |astp| must be NULL, |astf| must specify
the AST function, |addr| the IP address as a string, and |name| a pointer to a
buffer 128 bytes capacity.  The AST function is called with NULL parameter if
the host name is not resolved, or with a pointer to a string that must be freed
when no longer required.

There's a bit of sleight of hand going on here.  When this function calls
itself as an AST the |astp| (AST parameter) points to the internal LookupStruct
below.  When called to lookup an address it points to an opaque object used by
the lookup AST function.  How to tell the difference?  A couple of magic
numbers sandwiching the internal structure!
*/

void LookupHostName
(
void *astp,
void *astf,
char *addr,
char *name
)
{
#define RETRY_ATTEMPTS   5

#define INETACP$C_TRANS 2
#define INETACP_FUNC$C_GETHOSTBYNAME 1
#define INETACP_FUNC$C_GETHOSTBYADDR 2

   struct LookupStruct
   {
       int64  sleight1;
       int  RetryCount;
       ushort  HostNameLength;
       ulong  Ip4Address;
       ulong  Ip6Address [4];
       char  HostName [127+1],
             IpAddrStr [31+1];
       char  *NamePtr;
       struct dsc$descriptor HostAddressDsc;
       struct dsc$descriptor HostNameDsc;
       struct _iosb  LookupIOsb;
       void  *AstFunction;
       void  *AstParam;
       int64  sleight2;
   };

   static $DESCRIPTOR (TcpIpDeviceDsc, "UCX$DEVICE");
   static unsigned char ControlSubFunction [4] =
      { INETACP_FUNC$C_GETHOSTBYADDR, INETACP$C_TRANS, 0, 0 };
   static struct dsc$descriptor ControlSubFunctionDsc =
      { 4, DSC$K_DTYPE_T, DSC$K_CLASS_S, (char*)&ControlSubFunction };

   static int  CacheUsed;
   static unsigned short  LookupChannel;

   int  status;
   char  *cptr, *sptr, *zptr;
   struct LookupStruct  *luptr;

   /*********/
   /* begin */
   /*********/

   if (dbug) fprintf (stdout, "LookupHostName()\n");

   if (!LookupChannel)
   {
      /* assign a channel to the internet template device */
      status = sys$assign (&TcpIpDeviceDsc, &LookupChannel, 0, 0);
      if (VMSnok (status)) exit (status);
   }

   luptr = (struct LookupStruct*)astp;
   if (luptr->sleight1 != 0xbadc0ffee0ddf00d ||
       luptr->sleight2 != 0xbadc0ffee0ddf00d)
   {
      /**************************/
      /* lookup this IP address */
      /**************************/

      if (!(astf && addr && name)) EXIT_FI_LI (SS$_BUGCHECK);

      luptr = (struct LookupStruct*)calloc (1, sizeof(struct LookupStruct));
      if (!luptr)
      {
         status = sys$dclast (astf, astp, 0);
         if (VMSnok (status)) EXIT_FI_LI (status);
         return;
      }
      luptr->sleight1 = luptr->sleight2 = 0xbadc0ffee0ddf00d;
      luptr->AstFunction = astf;
      luptr->AstParam = astp;
      luptr->NamePtr = name;
      luptr->RetryCount = RETRY_ATTEMPTS;
      luptr->HostNameDsc.dsc$b_class = DSC$K_CLASS_S;
      luptr->HostNameDsc.dsc$b_dtype = DSC$K_DTYPE_T;
      luptr->HostNameDsc.dsc$w_length = sizeof(luptr->HostName)-1;
      luptr->HostNameDsc.dsc$a_pointer = luptr->HostName;
      luptr->HostAddressDsc.dsc$b_class = DSC$K_CLASS_S;
      luptr->HostAddressDsc.dsc$b_dtype = DSC$K_DTYPE_T;

      if (strchr (addr, ':'))
      {
         if (inet_pton (AF_INET6, addr, &luptr->Ip6Address) != 1)
         {
            free (luptr);
            status = sys$dclast (astf, astp, 0);
            if (VMSnok (status)) EXIT_FI_LI (status);
            return;
         }
         luptr->Ip4Address = 0;
      }
      else
      if (inet_pton (AF_INET, addr, &luptr->Ip4Address) != 1)
      {
         free (luptr);
         status = sys$dclast (astf, astp, 0);
         if (VMSnok (status)) EXIT_FI_LI (status);
         return;
      }

      zptr = (sptr = luptr->IpAddrStr) + sizeof(luptr->IpAddrStr)-1;
      for (cptr = addr; *cptr && sptr < zptr; *sptr++ = *cptr++);
      *sptr = '\0';

      if (luptr->Ip4Address)
      {
         luptr->HostAddressDsc.dsc$w_length = sizeof(luptr->Ip4Address);
         luptr->HostAddressDsc.dsc$a_pointer = (char*)&luptr->Ip4Address;
      }
      else
      {
         luptr->HostAddressDsc.dsc$w_length = sizeof(luptr->Ip6Address);
         luptr->HostAddressDsc.dsc$a_pointer = (char*)&luptr->Ip6Address;
      }
   }
   else
   {
      /**************/
      /* lookup AST */
      /**************/

      status = luptr->LookupIOsb.iosb$w_status;

      if (dbug) fprintf (stdout, "sys$qio() %%X%08.08X\n", status);

      if (VMSok (status)) 
      {
         luptr->HostName[luptr->HostNameLength] = '\0';
         if (dbug) fprintf (stdout, "|%s|\n", luptr->HostName);
         strcpy (luptr->NamePtr, luptr->HostName);
         astf = luptr->AstFunction;
         astp = luptr->AstParam;
         free (luptr);
         status = sys$dclast (astf, astp, 0);
         if (VMSnok (status)) EXIT_FI_LI (status);
         return;
      }

      if (status == SS$_ENDOFFILE ||
          !luptr->RetryCount--)
      {
         astf = luptr->AstFunction;
         astp = luptr->AstParam;
         free (luptr);
         status = sys$dclast (astf, astp, 0);
         if (VMSnok (status)) EXIT_FI_LI (status);
         return;
      }

      luptr->RetryCount--;
   }

   status = sys$qio (0, LookupChannel, IO$_ACPCONTROL | IO$M_EXTEND,
                     &luptr->LookupIOsb,
                     LookupHostName, luptr,
                     &ControlSubFunctionDsc,
                     &luptr->HostAddressDsc,
                     &luptr->HostNameLength,
                     &luptr->HostNameDsc, 0, 0);
   if (dbug) fprintf (stdout, "sys$qio() %%X%08.08X\n", status);

   if (VMSnok (status)) EXIT_FI_LI (status);
}

/*****************************************************************************/
/*
Generate an access port name from the remote host and port.  The presence of a
non-empty ->AccPorNam string indicates that this should be undone during
terminal/client delete (otherwise non-paged-pool will surely leak).
*/

#if ACCPORNAM_BUILD

void SetClientAccPorNam (struct PtdClient *clptr)

{
   int  status;
   char  *cptr, *sptr, *zptr;

   if (!clptr->RemoteAddr[0])
   {
      if (!(cptr = WsLibCgiVarNull("REMOTE_ADDR"))) cptr = "?";
      zptr = (sptr = clptr->RemoteAddr) + sizeof(clptr->RemoteAddr)-1;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';

      /* non-empty acts as a flag indicating a lookup is in progress */
      if (!(cptr = WsLibCgiVarNull("REMOTE_PORT"))) cptr = "?";
      zptr = (sptr = clptr->RemotePort) + sizeof(clptr->RemotePort)-1;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';

      if (!(cptr = WsLibCgiVarNull("REMOTE_HOST"))) cptr = "?";

      if (!strcasecmp (cptr, clptr->RemoteAddr))
      {
         /* the host and address are the same so WASD lookup is not enabled */
         LookupHostName (clptr, SetClientAccPorNam, cptr, clptr->RemoteHost);
         return;
      }

      /* otherwise just use the already looked up name */
      zptr = (sptr = clptr->RemoteHost) + sizeof(clptr->RemoteHost)-1;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
   }

   if (!clptr->RemotePort[0])
   {
      /* empty indicates the process has terminated during lookup */
      PtdTerminateFree (clptr);
      return;
   }

   if (!clptr->RemoteHost[0]) strcpy (clptr->RemoteHost, clptr->RemoteAddr);

   zptr = (sptr = clptr->AccPorNam) + sizeof(clptr->AccPorNam)-1;
   sptr++;
   for (cptr = AccPorNamPrefix; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = clptr->RemoteHost; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = ':';
   for (cptr = clptr->RemotePort; *cptr && sptr < zptr; *sptr++ = *cptr++);
   clptr->AccPorNam[0] = sptr - (clptr->AccPorNam + 1);

   status = SetAccPorNam (clptr->ptdchan, clptr->AccPorNam);
   if (clptr->WatchScript)
      ConsoleCallout (clptr, FI_LI,
                      "SetAccPortNam() %d %d|%s| %%X%08.08X",
                      clptr->ptdchan, clptr->AccPorNam[0],
                      clptr->AccPorNam+1, status);
   if (VMSnok(status))
      memset (clptr->AccPorNam, 0, sizeof(clptr->AccPorNam));

   /* reset the flag indicating a lookup is in progress */
   clptr->RemotePort[0] = '\0';

   PtdBegin (clptr);
}

#endif

/*****************************************************************************/
/*
Call the kernel-mode function to set an otherwise empty terminal ACCPORNAM into
a DCLinabox ACCPORNAM.
*/

#if ACCPORNAM_BUILD

int SetAccPorNam (ushort channel, char cstring[])

{
   static unsigned long  CmKrnlMask [2] = { PRV$M_CMKRNL, 0 };

   __int32  nppsize;
   int  status, kstatus;
   int  arglist [4] = { 3, channel, (int)cstring, (int)&nppsize };

   status = sys$setprv (1, &CmKrnlMask, 0, 0);
   /* if not installed with CMKRNL then might as well quit here */
   if (status == SS$_NOTALLPRIV) return (status);

   AccPorNamCount++;

   status = lib$lock_image (0);
   if (VMSnok(status)) EXIT_FI_LI (status);

   kstatus = sys$cmkrnl (&KrnlSetAccPorNam, &arglist);

   sys$setprv (0, &CmKrnlMask, 0, 0);

   status = lib$unlock_image (0);
   if (VMSnok(status)) EXIT_FI_LI (status);

   if (VMSnok(kstatus))
      if (kstatus != SS$_NOPRIV)
         EXIT_FI_LI (kstatus);

   if (VMSok(kstatus))
      if (cstring[0])
         AccPorNamSetCount++;
#if !(ACCPORNAM_LEAK)
      else
         AccPorNamResetCount++;
#endif

#if OPCOM_DBUG
   if (cstring[0]) OpcomMessage ("S/SetAccPorNam() nppsize:!UL", nppsize);
#endif

   return (kstatus);
}

#endif

/*****************************************************************************/
/*
Basic access into the UCB came from Jim Duff's code

  http://www.eight-cubed.com/blog/archives/001289.html

Also useful for some general principals are Writing VMS Privileged Code by
Hunter Goatley and Edward A. Heinrich, originally articles published in VAX
Professional during 1993 and 1994.

  https://hunter.goatley.com/writing-vms-privileged-code/

And again, Hunter Goatley, longtime VMS enthusiast and software engineer,
specifically for his suggestions and assistance with aspects of privileged mode
programming.

Any over-arching clunkiness belongs entirely to yours truly.

The function will only set the terminal ACCPORNAM if ->ucb$l_tt_accpornam is
currently not set.  Returns SS$_FISH if already set.

If cstring is empty then undo all the good work.
*/

#if ACCPORNAM_BUILD

#define ACCPORNAM_SIZE 65

#include <ucbdef.h>
#include <ttyucbdef.h>
#include <vms_drivers.h>
#include <ccbdef.h>
#include <psldef.h>
#include <exe_routines.h>
#include <ioc_routines.h>
#include <mutexdef.h>
#include <sch_routines.h>
#include <vms_macros.h>
#include <lib$routines.h>
#include <starlet.h>

int KrnlSetAccPorNam (int channel, char cstring[], __int32* size_p)

{
   extern PCB *CTL$GL_PCB;

   static __int32  cnt, retval, status;
   static int  orig_ipl;
   static char  *npp_p;
   static MUTEX  *mutex;
   static PCB  *pcb_p;
   static CCB  *ccb_p;
   static UCB  *ucb_p;
   static TTY_UCB  *tty_ucb_p;

   if (channel == 0 || cstring == NULL || cstring[0] < 0 || cstring[0] > 64)
      return (SS$_BADPARAM);

   retval = SS$_NORMAL;

   /* get the address of the process control block */
   pcb_p = CTL$GL_PCB;

   /* lock I/O database mutex for write */
   mutex = sch_std$iolockw (pcb_p);

   /* get the channel control block */
   status = ioc$chan_to_ccb (channel, &ccb_p);
   if (status & 1)
   {
      /* valid channel so set the unit control block */
      tty_ucb_p = (TTY_UCB*)ccb_p->ccb$l_ucb;

      ucb_p = (UCB*)tty_ucb_p;
      device_lock (ucb_p->ucb$l_dlck, RAISE_IPL, &orig_ipl);

      if (!cstring[0])
      {
         /* reset the ->ucb$l_tt_accpornam */
         if (!(npp_p = tty_ucb_p->ucb$l_tt_accpornam))
            retval = SS$_FISH;
         else
         {
#if !(ACCPORNAM_LEAK)
            /* first check this has been set by DCLinabox */
            for (cnt = 0; AccPorNamPrefix[cnt]; cnt++)
               if (npp_p[cnt+1] != AccPorNamPrefix[cnt])
                  break;
            if (!AccPorNamPrefix[cnt])
            {
               /* the datum is no longer in use (?) */
               tty_ucb_p->ucb$w_tt_prtctl &= ~TTY$M_PC_ACCPORNAM;
               retval = exe_std$deanonpgdsiz (npp_p, ACCPORNAM_SIZE);
               if (retval & 1) tty_ucb_p->ucb$l_tt_accpornam = 0;
            }
            else
               retval = SS$_FISH;
#endif
         }
         *size_p = 0;
      }
      else
      /* if there already is an ACCPORNAM set then do not proceed */
      if (tty_ucb_p->ucb$l_tt_accpornam)
         retval = SS$_FISH;
      else
      {
         /* allocate non-paged memory */
         status = exe_std$alononpaged (ACCPORNAM_SIZE, size_p, (void*)&npp_p);
         if (status & 1)
         {
            /* flag the datum is in use (?) */
            tty_ucb_p->ucb$w_tt_prtctl |= TTY$M_PC_ACCPORNAM;
            /* copy in the counted string */
            for (cnt = 0; cnt < ACCPORNAM_SIZE; cnt++)
               npp_p[cnt] = cstring[cnt];
            tty_ucb_p->ucb$l_tt_accpornam = npp_p;
         }
         else
            retval = status;
      }

      device_unlock (ucb_p->ucb$l_dlck, orig_ipl, SMP_RESTORE);
   }
   else
      retval = status;

   sch_std$iounlock (pcb_p);

   return (retval);
}

#endif

/*****************************************************************************/